test/test-server.sgl

1(import (sigil test)

2 (sigil mcp server)

3 (sigil mcp protocol)

4 (sigil json)

5 (sigil string)

6 (sigil io)

7 (sigil log)

8 (sigil async))

10;; ============================================================

11;; Server creation

12;; ============================================================

14(test-group "server creation"

15 (test "mcp-server creates a server"

16 (let ((s (mcp-server)))

17 (assert-true (mcp-server? s))))

19 (test "mcp-server with custom name and version"

20 (let ((s (mcp-server name: "test-server" version: "1.0.0")))

21 (assert-true (mcp-server? s))))

23 (test "mcp-server? returns false for non-server"

24 (assert-false (mcp-server? 42))

25 (assert-false (mcp-server? "hello"))))

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

28;; Tool registration

29;; ============================================================

31(test-group "tool registration"

32 (test "register-tool adds tool to server"

33 (let ((s (mcp-server)))

34 (mcp-server-register-tool! s "test-tool" "A test tool"

35 '((type . "object")) (lambda (args) "ok"))

36 (let* ((msg (jsonrpc-request id: 1 method: "tools/list" params: (dict)))

37 (resp (mcp-server-handle-message s msg))

38 (result (jsonrpc-response-result resp))

39 (tools (assoc-ref 'tools result)))

40 (assert-equal 1 (length tools))

41 (assert-equal "test-tool" (assoc-ref 'name (car tools))))))

43 (test "multiple tools accumulate"

44 (let ((s (mcp-server)))

45 (mcp-server-register-tool! s "tool-a" "First" '() (lambda (a) "a"))

46 (mcp-server-register-tool! s "tool-b" "Second" '() (lambda (a) "b"))

47 (let* ((msg (jsonrpc-request id: 1 method: "tools/list" params: (dict)))

48 (resp (mcp-server-handle-message s msg))

49 (result (jsonrpc-response-result resp))

50 (tools (assoc-ref 'tools result)))

51 (assert-equal 2 (length tools))))))

53;; ============================================================

54;; Resource registration

55;; ============================================================

57(test-group "resource registration"

58 (test "register-resource adds resource"

59 (let ((s (mcp-server)))

60 (mcp-server-register-resource! s "test://doc" "Test Doc"

61 "A test document" (lambda (uri) "content"))

62 (let* ((msg (jsonrpc-request id: 1 method: "resources/list" params: (dict)))

63 (resp (mcp-server-handle-message s msg))

64 (result (jsonrpc-response-result resp))

65 (resources (assoc-ref 'resources result)))

66 (assert-equal 1 (length resources))

67 (assert-equal "test://doc" (assoc-ref 'uri (car resources)))))))

69;; ============================================================

70;; Prompt registration

71;; ============================================================

73(test-group "prompt registration"

74 (test "register-prompt adds prompt"

75 (let ((s (mcp-server)))

76 (mcp-server-register-prompt! s "test-prompt" "A test prompt"

77 '() (lambda (args) '()))

78 (let* ((msg (jsonrpc-request id: 1 method: "prompts/list" params: (dict)))

79 (resp (mcp-server-handle-message s msg))

80 (result (jsonrpc-response-result resp))

81 (prompts (assoc-ref 'prompts result)))

82 (assert-equal 1 (length prompts))

83 (assert-equal "test-prompt" (assoc-ref 'name (car prompts)))))))

85;; ============================================================

86;; Initialize

87;; ============================================================

89(test-group "initialize"

90 (test "initialize returns capabilities"

91 (let* ((s (mcp-server name: "test" version: "1.0"))

92 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

93 (resp (mcp-server-handle-message s msg))

94 (result (jsonrpc-response-result resp)))

95 (assert-true (jsonrpc-response? resp))

96 (assert-equal 1 (jsonrpc-response-id resp))

97 (assert-equal "2025-11-25" (assoc-ref 'protocolVersion result))

98 (let ((info (assoc-ref 'serverInfo result)))

99 (assert-equal "test" (assoc-ref 'name info))

100 (assert-equal "1.0" (assoc-ref 'version info))))))

101

102;; ============================================================

103;; Ping

104;; ============================================================

105

106(test-group "ping"

107 (test "ping returns empty response"

108 (let* ((s (mcp-server))

109 (msg (jsonrpc-request id: 42 method: "ping" params: (dict)))

110 (resp (mcp-server-handle-message s msg)))

111 (assert-true (jsonrpc-response? resp))

112 (assert-equal 42 (jsonrpc-response-id resp)))))

113

114;; ============================================================

115;; tools/call

116;; ============================================================

117

118(test-group "tools/call"

119 (test "call valid tool returns result"

120 (let ((s (mcp-server)))

121 (mcp-server-register-tool! s "echo" "Echo tool"

122 '((type . "object"))

123 (lambda (args) (dict-ref args message:)))

124 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

125 params: (dict name: "echo"

126 arguments: (dict message: "hello"))))

127 (resp (mcp-server-handle-message s msg))

128 (result (jsonrpc-response-result resp))

129 (content (assoc-ref 'content result)))

130 (assert-true (jsonrpc-response? resp))

131 (assert-equal "hello" (assoc-ref 'text (car content))))))

132

133 (test "call unknown tool returns error"

134 (let* ((s (mcp-server))

135 (msg (jsonrpc-request id: 1 method: "tools/call"

136 params: (dict name: "nonexistent")))

137 (resp (mcp-server-handle-message s msg)))

138 (assert-true (jsonrpc-error-response? resp))

139 (assert-equal error-method-not-found (jsonrpc-error-response-code resp))))

140

141 (test "tool handler exception returns error response"

142 (let ((s (mcp-server)))

143 (mcp-server-register-tool! s "fail" "Failing tool" '()

144 (lambda (args) (error "intentional failure")))

145 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

146 params: (dict name: "fail")))

147 (resp (mcp-server-handle-message s msg)))

148 (assert-true (jsonrpc-error-response? resp))

149 (assert-equal error-internal (jsonrpc-error-response-code resp)))))

150

151 ;; Required-args validation: handler must NOT be called when a required

152 ;; field from inputSchema.required is absent. Without this validation,

153 ;; handlers using `(dict-ref args X:)` (no default) raise "dict-ref: key

154 ;; not found", which escapes as an opaque multi-frame stack trace. The

155 ;; validation surfaces a structured error-invalid-params instead.

156 (test "missing required arg returns invalid-params (not handler call)"

157 (let ((s (mcp-server))

158 (handler-called #f))

159 (mcp-server-register-tool! s "needs-org" "Tool requiring org"

160 '((type . "object")

161 (properties . ((org . ((type . "string")))))

162 (required . ("org")))

163 (lambda (args)

164 (set! handler-called #t)

165 (dict-ref args org:)))

166 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

167 params: (dict name: "needs-org" arguments: (dict))))

168 (resp (mcp-server-handle-message s msg)))

169 (assert-true (jsonrpc-error-response? resp))

170 (assert-equal error-invalid-params (jsonrpc-error-response-code resp))

171 (assert-false handler-called))))

172

173 (test "multiple missing required args listed in error"

174 (let ((s (mcp-server)))

175 (mcp-server-register-tool! s "needs-two" "Tool requiring owner + repo"

176 '((type . "object")

177 (properties . ((owner . ((type . "string")))

178 (repo . ((type . "string")))))

179 (required . ("owner" "repo")))

180 (lambda (args) "should not reach"))

181 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

182 params: (dict name: "needs-two" arguments: (dict))))

183 (resp (mcp-server-handle-message s msg))

184 (err-msg (jsonrpc-error-response-message resp)))

185 (assert-true (jsonrpc-error-response? resp))

186 (assert-equal error-invalid-params (jsonrpc-error-response-code resp))

187 (assert-true (string-contains? err-msg "owner"))

188 (assert-true (string-contains? err-msg "repo")))))

189

190 (test "required args all present dispatches normally"

191 (let ((s (mcp-server)))

192 (mcp-server-register-tool! s "needs-org" "Tool requiring org"

193 '((type . "object")

194 (properties . ((org . ((type . "string")))))

195 (required . ("org")))

196 (lambda (args)

197 (string-append "org=" (dict-ref args org:))))

198 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

199 params: (dict name: "needs-org"

200 arguments: (dict org: "sigil"))))

201 (resp (mcp-server-handle-message s msg))

202 (result (jsonrpc-response-result resp))

203 (content (assoc-ref 'content result)))

204 (assert-true (jsonrpc-response? resp))

205 (assert-equal "org=sigil" (assoc-ref 'text (car content))))))

206

207 (test "schema with no required field skips validation"

208 (let ((s (mcp-server)))

209 (mcp-server-register-tool! s "anything-goes" "Tool with no required args"

210 '((type . "object")

211 (properties . ((opt . ((type . "string"))))))

212 (lambda (args) "ok"))

213 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

214 params: (dict name: "anything-goes" arguments: (dict))))

215 (resp (mcp-server-handle-message s msg))

216 (result (jsonrpc-response-result resp))

217 (content (assoc-ref 'content result)))

218 (assert-true (jsonrpc-response? resp))

219 (assert-equal "ok" (assoc-ref 'text (car content)))))))

220

221;; ============================================================

222;; tool-handler error isolation — dispatch loop must survive a raise

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

224;;

225;; Regression for the "MCP dispatch continuation wedge": a tool handler

226;; that raises must return a clean JSON-RPC error AND leave the server

227;; loop alive to serve the NEXT request. The earlier workaround used a

228;; call/cc escape from inside a with-exception-handler to dodge a Sigil

229;; VM bug (exception propagation through map's CPS frames corrupting

230;; call-with-prompt's return context). On the buggy VM that escape jumped

231;; past the dispatch loop's continuation, so the loop never resumed and

232;; the next request got "Connection closed". The VM bug was fixed in

233;; sigil v0.16.0 (the guard-raise-escape / abort-propagation fix), so

234;; handle-tools-call now uses a plain `guard` like every other handler.

235;;

236;; These tests drive the full mcp-server-run loop: a raising tools/call

237;; followed by a second request, asserting BOTH get well-formed responses.

238;; The async variant runs inside with-async/go with logging enabled,

239;; reproducing the production context (scheduler prompt + async logging

240;; path live on the stack) where the wedge originally manifested.

241

242(define (drive-loop server input-string)

243 ;; Run mcp-server-run over a string input, returning the non-empty

244 ;; response lines written to stdout.

245 (let ((input (open-input-string input-string))

246 (output (open-output-string)))

247 (parameterize ((current-input-port input)

248 (current-output-port output))

249 (mcp-server-run server load-env?: #f))

250 (filter (lambda (l) (not (string-empty? l)))

251 (string-split (get-output-string output) "\n"))))

252

253(define (raise+follow-up-input)

254 (string-append

255 (json-encode (dict jsonrpc: "2.0" id: 1 method: "tools/call"

256 params: (dict name: "boom" arguments: (dict))))

257 "\n"

258 (json-encode (dict jsonrpc: "2.0" id: 2 method: "ping" params: (dict)))

259 "\n"))

260

261(test-group "tool-handler error isolation"

262 (test "raising tool/call returns error AND loop serves next request"

263 (let ((s (mcp-server name: "test" version: "1.0")))

264 (mcp-server-register-tool! s "boom" "Always fails" '()

265 (lambda (args) (error "intentional boom")))

266 (let ((lines (drive-loop s (raise+follow-up-input))))

267 ;; Both requests answered: loop survived the raise.

268 (assert-equal 2 (length lines))

269 (let ((resp1 (json-decode (car lines)))

270 (resp2 (json-decode (cadr lines))))

271 ;; First: well-formed JSON-RPC error for the raising call.

272 (assert-equal 1 (dict-ref resp1 id:))

273 (assert-true (dict-ref resp1 error: #f))

274 (assert-equal error-internal

275 (dict-ref (dict-ref resp1 error:) code:))

276 ;; Second: the follow-up ping succeeded (no "Connection closed").

277 (assert-equal 2 (dict-ref resp2 id:))

278 (assert-false (dict-ref resp2 error: #f))))))

279

280 (test "loop survives a raising tool/call inside with-async/go"

281 ;; Faithful to production: mcp-server-run runs in a goroutine and

282 ;; logging routes through the async await-port-writable path. Logs

283 ;; go to a sink port so they don't pollute test output.

284 (let ((s (mcp-server name: "test" version: "1.0"))

285 (log-sink (open-output-string))

286 (input (open-input-string (raise+follow-up-input)))

287 (output (open-output-string)))

288 (mcp-server-register-tool! s "boom" "Always fails" '()

289 (lambda (args) (error "intentional boom")))

290 (log-configure! level: 'debug target: log-sink)

291 (parameterize ((current-input-port input)

292 (current-output-port output))

293 (with-async

294 (go (mcp-server-run s load-env?: #f))))

295 (log-configure! level: 'warn target: 'console)

296 (let ((lines (filter (lambda (l) (not (string-empty? l)))

297 (string-split (get-output-string output) "\n"))))

298 (assert-equal 2 (length lines))

299 (let ((resp1 (json-decode (car lines)))

300 (resp2 (json-decode (cadr lines))))

301 (assert-true (dict-ref resp1 error: #f))

302 (assert-equal 2 (dict-ref resp2 id:))

303 (assert-false (dict-ref resp2 error: #f)))))))

304

305;; ============================================================

306;; resources/read

307;; ============================================================

308

309(test-group "resources/read"

310 (test "read valid resource returns content"

311 (let ((s (mcp-server)))

312 (mcp-server-register-resource! s "test://hello" "Hello"

313 "Hello resource" (lambda (uri) "Hello, world!"))

314 (let* ((msg (jsonrpc-request id: 1 method: "resources/read"

315 params: (dict uri: "test://hello")))

316 (resp (mcp-server-handle-message s msg))

317 (result (jsonrpc-response-result resp))

318 (contents (assoc-ref 'contents result)))

319 (assert-true (jsonrpc-response? resp))

320 (assert-equal "Hello, world!" (assoc-ref 'text (car contents)))

321 (assert-equal "test://hello" (assoc-ref 'uri (car contents))))))

322

323 (test "read with wildcard match"

324 (let ((s (mcp-server)))

325 (mcp-server-register-resource! s "docs://pages/*" "Pages"

326 "Doc pages" (lambda (uri) (string-append "Page: " uri)))

327 (let* ((msg (jsonrpc-request id: 1 method: "resources/read"

328 params: (dict uri: "docs://pages/intro")))

329 (resp (mcp-server-handle-message s msg))

330 (result (jsonrpc-response-result resp))

331 (contents (assoc-ref 'contents result)))

332 (assert-true (jsonrpc-response? resp))

333 (assert-equal "Page: docs://pages/intro"

334 (assoc-ref 'text (car contents))))))

335

336 (test "read unknown resource returns error"

337 (let* ((s (mcp-server))

338 (msg (jsonrpc-request id: 1 method: "resources/read"

339 params: (dict uri: "test://missing")))

340 (resp (mcp-server-handle-message s msg)))

341 (assert-true (jsonrpc-error-response? resp))

342 (assert-equal error-invalid-params (jsonrpc-error-response-code resp))))

343

344 (test "resource handler exception returns error"

345 (let ((s (mcp-server)))

346 (mcp-server-register-resource! s "test://boom" "Boom"

347 "Failing resource" (lambda (uri) (error "resource failed")))

348 (let* ((msg (jsonrpc-request id: 1 method: "resources/read"

349 params: (dict uri: "test://boom")))

350 (resp (mcp-server-handle-message s msg)))

351 (assert-true (jsonrpc-error-response? resp))

352 (assert-equal error-internal (jsonrpc-error-response-code resp))))))

353

354;; ============================================================

355;; prompts/get

356;; ============================================================

357

358(test-group "prompts/get"

359 (test "get valid prompt calls handler"

360 (let ((s (mcp-server)))

361 (mcp-server-register-prompt! s "greet" "Greeting prompt"

362 '(((name . "name") (description . "Name to greet") (required . #t)))

363 (lambda (args)

364 `(((role . "user")

365 (content . ((text . ,(string-append "Hello, "

366 (dict-ref args name: "world")))))))))

367 (let* ((msg (jsonrpc-request id: 1 method: "prompts/get"

368 params: (dict name: "greet"

369 arguments: (dict name: "Alice"))))

370 (resp (mcp-server-handle-message s msg))

371 (result (jsonrpc-response-result resp))

372 (messages (assoc-ref 'messages result)))

373 (assert-true (jsonrpc-response? resp))

374 (assert-equal 1 (length messages)))))

375

376 (test "get unknown prompt returns error"

377 (let* ((s (mcp-server))

378 (msg (jsonrpc-request id: 1 method: "prompts/get"

379 params: (dict name: "nonexistent")))

380 (resp (mcp-server-handle-message s msg)))

381 (assert-true (jsonrpc-error-response? resp))

382 (assert-equal error-method-not-found (jsonrpc-error-response-code resp))))

383

384 (test "prompt handler exception returns error"

385 (let ((s (mcp-server)))

386 (mcp-server-register-prompt! s "fail" "Failing prompt" '()

387 (lambda (args) (error "prompt error")))

388 (let* ((msg (jsonrpc-request id: 1 method: "prompts/get"

389 params: (dict name: "fail")))

390 (resp (mcp-server-handle-message s msg)))

391 (assert-true (jsonrpc-error-response? resp))

392 (assert-equal error-internal (jsonrpc-error-response-code resp))))))

393

394;; ============================================================

395;; Unknown method

396;; ============================================================

397

398(test-group "unknown method"

399 (test "unknown method returns error-method-not-found"

400 (let* ((s (mcp-server))

401 (msg (jsonrpc-request id: 1 method: "nonexistent/method" params: (dict)))

402 (resp (mcp-server-handle-message s msg)))

403 (assert-true (jsonrpc-error-response? resp))

404 (assert-equal error-method-not-found (jsonrpc-error-response-code resp)))))

405

406;; ============================================================

407;; Notifications

408;; ============================================================

409

410(test-group "notifications"

411 (test "initialized notification returns #f"

412 (let* ((s (mcp-server))

413 (msg (jsonrpc-notification method: "initialized" params: (dict)))

414 (resp (mcp-server-handle-message s msg)))

415 (assert-false resp)))

416

417 (test "cancelled notification returns #f"

418 (let* ((s (mcp-server))

419 (msg (jsonrpc-notification method: "notifications/cancelled" params: (dict)))

420 (resp (mcp-server-handle-message s msg)))

421 (assert-false resp))))

422

423;; ============================================================

424;; Invalid messages

425;; ============================================================

426

427(test-group "invalid messages"

428 (test "non-request non-notification returns error"

429 (let* ((s (mcp-server))

430 (resp (mcp-server-handle-message s "not a message")))

431 (assert-true (jsonrpc-error-response? resp))

432 (assert-equal error-invalid-request (jsonrpc-error-response-code resp)))))

433

434;; ============================================================

435;; Custom capabilities

436;; ============================================================

437

438(test-group "custom capabilities"

439 (test "initialize includes custom capabilities merged with defaults"

440 (let* ((s (mcp-server name: "test" version: "1.0"

441 capabilities: '((experimental . ((claude/channel . ()))))))

442 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

443 (resp (mcp-server-handle-message s msg))

444 (result (jsonrpc-response-result resp))

445 (caps (assoc-ref 'capabilities result)))

446 ;; Custom capability present

447 (assert-true (assoc 'experimental caps))

448 ;; Default capabilities still present

449 (assert-true (assoc 'tools caps))

450 ;; resources and prompts omitted when none registered

451 (assert-false (assoc 'resources caps))

452 (assert-false (assoc 'prompts caps))))

453

454 (test "custom capabilities override defaults"

455 (let* ((s (mcp-server name: "test" version: "1.0"

456 capabilities: '((tools . ((listChanged . #t))))))

457 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

458 (resp (mcp-server-handle-message s msg))

459 (result (jsonrpc-response-result resp))

460 (caps (assoc-ref 'capabilities result))

461 (tools (assoc-ref 'tools caps)))

462 ;; Custom value used instead of default

463 (assert-equal #t (assoc-ref 'listChanged tools))))

464

465 (test "no custom capabilities uses defaults"

466 (let* ((s (mcp-server name: "test" version: "1.0"))

467 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

468 (resp (mcp-server-handle-message s msg))

469 (result (jsonrpc-response-result resp))

470 (caps (assoc-ref 'capabilities result)))

471 (assert-true (assoc 'tools caps))

472 ;; resources and prompts omitted when none registered

473 (assert-false (assoc 'resources caps))

474 (assert-false (assoc 'prompts caps))

475 (assert-false (assoc 'experimental caps))))

476

477 (test "resources capability advertised when resources registered"

478 (let* ((s (mcp-server name: "test" version: "1.0")))

479 (mcp-server-register-resource! s "test://doc" "doc" "A test resource"

480 (lambda (uri) "content"))

481 (let* ((msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

482 (resp (mcp-server-handle-message s msg))

483 (result (jsonrpc-response-result resp))

484 (caps (assoc-ref 'capabilities result)))

485 (assert-true (assoc 'resources caps))

486 (assert-false (assoc 'prompts caps)))))

487

488 (test "prompts capability advertised when prompts registered"

489 (let* ((s (mcp-server name: "test" version: "1.0")))

490 (mcp-server-register-prompt! s "greet" "A greeting prompt" '()

491 (lambda (args) "Hello!"))

492 (let* ((msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

493 (resp (mcp-server-handle-message s msg))

494 (result (jsonrpc-response-result resp))

495 (caps (assoc-ref 'capabilities result)))

496 (assert-false (assoc 'resources caps))

497 (assert-true (assoc 'prompts caps))))))

498

499;; ============================================================

500;; Instructions

501;; ============================================================

502

503(test-group "instructions"

504 (test "initialize includes instructions when set"

505 (let* ((s (mcp-server name: "test" version: "1.0"

506 instructions: "Reply with the reply tool."))

507 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

508 (resp (mcp-server-handle-message s msg))

509 (result (jsonrpc-response-result resp)))

510 (assert-equal "Reply with the reply tool."

511 (assoc-ref 'instructions result))))

512

513 (test "initialize omits instructions when not set"

514 (let* ((s (mcp-server name: "test" version: "1.0"))

515 (msg (jsonrpc-request id: 1 method: "initialize" params: (dict)))

516 (resp (mcp-server-handle-message s msg))

517 (result (jsonrpc-response-result resp)))

518 (assert-false (assoc-ref 'instructions result #f)))))

519

520;; ============================================================

521;; Server-initiated notifications

522;; ============================================================

523

524(test-group "server notify"

525 (test "mcp-server-notify! writes JSON-RPC notification to output"

526 (let* ((s (mcp-server name: "test" version: "1.0"))

527 (port (open-output-string)))

528 (parameterize ((current-output-port port))

529 (mcp-server-notify! s "notifications/claude/channel"

530 params: '((content . "hello from telegram")

531 (meta . ((sender . "david"))))))

532 (let* ((output (get-output-string port))

533 (parsed (json-decode output)))

534 (assert-equal "2.0" (dict-ref parsed jsonrpc:))

535 (assert-equal "notifications/claude/channel" (dict-ref parsed method:))

536 (let ((params (dict-ref parsed params:)))

537 (assert-equal "hello from telegram" (dict-ref params content:))

538 (assert-equal "david" (dict-ref (dict-ref params meta:) sender:))))))

539

540 (test "mcp-server-notify! without params"

541 (let* ((s (mcp-server name: "test" version: "1.0"))

542 (port (open-output-string)))

543 (parameterize ((current-output-port port))

544 (mcp-server-notify! s "notifications/test"))

545 (let* ((output (get-output-string port))

546 (parsed (json-decode output)))

547 (assert-equal "2.0" (dict-ref parsed jsonrpc:))

548 (assert-equal "notifications/test" (dict-ref parsed method:))

549 (assert-false (dict-ref parsed params: #f))))))

550

551;; ============================================================

552;; Server loop (mcp-server-run)

553;; ============================================================

554

555(test-group "server loop"

556 (test "processes messages from input port"

557 (let* ((init-msg (string-append

558 (json-encode (dict jsonrpc: "2.0" id: 1

559 method: "initialize" params: (dict)))

560 "\n"))

561 (ping-msg (string-append

562 (json-encode (dict jsonrpc: "2.0" id: 2

563 method: "ping" params: (dict)))

564 "\n"))

565 (input (open-input-string (string-append init-msg ping-msg)))

566 (output (open-output-string))

567 (s (mcp-server name: "test" version: "1.0")))

568 (parameterize ((current-input-port input)

569 (current-output-port output))

570 (mcp-server-run s load-env?: #f))

571 (let* ((lines (filter (lambda (l) (not (string-empty? l)))

572 (string-split (get-output-string output) "\n")))

573 (resp1 (json-decode (car lines)))

574 (resp2 (json-decode (cadr lines))))

575 (assert-equal 1 (dict-ref resp1 id:))

576 (assert-equal 2 (dict-ref resp2 id:)))))

577

578 (test "exits cleanly on EOF"

579 (let* ((input (open-input-string ""))

580 (output (open-output-string))

581 (s (mcp-server name: "test" version: "1.0")))

582 (parameterize ((current-input-port input)

583 (current-output-port output))

584 (mcp-server-run s load-env?: #f))

585 ;; Should reach here without error

586 (assert-true #t)))

587

588 (test "survives bad JSON input"

589 (let* ((bad-msg "not valid json\n")

590 (ping-msg (string-append

591 (json-encode (dict jsonrpc: "2.0" id: 1

592 method: "ping" params: (dict)))

593 "\n"))

594 (input (open-input-string (string-append bad-msg ping-msg)))

595 (output (open-output-string))

596 (s (mcp-server name: "test" version: "1.0")))

597 (parameterize ((current-input-port input)

598 (current-output-port output))

599 (mcp-server-run s load-env?: #f))

600 (let* ((lines (filter (lambda (l) (not (string-empty? l)))

601 (string-split (get-output-string output) "\n")))

602 ;; First response should be a parse error

603 (resp1 (json-decode (car lines)))

604 ;; Second response should be the ping reply

605 (resp2 (json-decode (cadr lines))))

606 (assert-true (dict-ref resp1 error: #f))

607 (assert-equal 1 (dict-ref resp2 id:)))))

608

609 (test "skips empty lines"

610 (let* ((ping-msg (string-append

611 (json-encode (dict jsonrpc: "2.0" id: 1

612 method: "ping" params: (dict)))

613 "\n"))

614 (input (open-input-string (string-append "\n\n" ping-msg "\n")))

615 (output (open-output-string))

616 (s (mcp-server name: "test" version: "1.0")))

617 (parameterize ((current-input-port input)

618 (current-output-port output))

619 (mcp-server-run s load-env?: #f))

620 (let* ((lines (filter (lambda (l) (not (string-empty? l)))

621 (string-split (get-output-string output) "\n"))))

622 (assert-equal 1 (length lines))

623 (assert-equal 1 (dict-ref (json-decode (car lines)) id:))))))

624

625(run-tests)