test/test-channel.sgl

1(import (sigil test)

2 (sigil io)

3 (sigil string)

4 (sigil mcp channel)

5 (sigil mcp server)

6 (sigil mcp protocol)

7 (sigil json))

9;; ============================================================

10;; Channel server creation

11;; ============================================================

13(test-group "mcp-channel-server"

14 (test "creates an MCP server"

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

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

18 (test "includes claude/channel capability in initialize response"

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

20 (msg (jsonrpc-request id: 1 method: "initialize"

21 params: `((protocolVersion . "2025-11-25")

22 (capabilities . ())

23 (clientInfo . ((name . "test-client"))))))

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

25 (result (jsonrpc-response-result resp))

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

27 (experimental (assoc-ref 'experimental caps))

28 (channel (assoc-ref 'claude/channel experimental)))

29 (assert-true (dict? channel))))

31 (test "merges additional capabilities"

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

33 capabilities: '((custom . ((feature . #t))))))

34 (msg (jsonrpc-request id: 1 method: "initialize"

35 params: `((protocolVersion . "2025-11-25")

36 (capabilities . ())

37 (clientInfo . ((name . "test-client"))))))

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

39 (result (jsonrpc-response-result resp))

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

41 ;; Has both custom and experimental capabilities

42 (assert-true (assoc 'custom caps))

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

45 (test "passes instructions through"

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

47 instructions: "Test instructions"))

48 (msg (jsonrpc-request id: 1 method: "initialize"

49 params: `((protocolVersion . "2025-11-25")

50 (capabilities . ())

51 (clientInfo . ((name . "test-client"))))))

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

53 (result (jsonrpc-response-result resp)))

54 (assert-equal "Test instructions" (assoc-ref 'instructions result)))))

56;; ============================================================

57;; Channel notifications

58;; ============================================================

60(test-group "channel-notify!"

61 (test "produces valid JSON-RPC channel notification"

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

63 (output (call-with-output-string

64 (lambda (port)

65 (parameterize ((current-output-port port))

66 (channel-notify! s "Hello world"

67 meta: '((type . "test"))))))))

68 ;; Should produce non-empty JSON output

69 (assert-true (> (string-length output) 0))

70 ;; Should be parseable JSON containing the channel method

71 (assert-true (string-find output "notifications/claude/channel"))

72 (assert-true (string-find output "Hello world"))

73 (assert-true (string-find output "test")))))