test/test-client.sgl

1(import (sigil test)

2 (sigil mcp client)

3 (sigil mcp protocol)

4 (sigil json))

6(define sent '())

7(define events '())

8(define now-value 100)

9(define client

10 (mcp-client send: (lambda (line) (set! sent (append sent (list line))))

11 event: (lambda (event) (set! events (append events (list event))))

12 now: (lambda () now-value)

13 max-frame-bytes: 256))

15(test-group "request correlation"

16 (test "out-of-order responses resolve by id"

17 (let* ((settled '())

18 (a (mcp-client-request! client "one" '()

19 (lambda (r) (set! settled (append settled

20 (list (jsonrpc-response-result r)))))))

21 (b (mcp-client-request! client "two" '()

22 (lambda (r) (set! settled (append settled

23 (list (jsonrpc-response-result r))))))))

24 (assert-equal 2 (mcp-client-pending-count client))

25 (mcp-client-handle-message! client (make-response b "second"))

26 (mcp-client-handle-message! client (make-response a "first"))

27 (assert-equal '("second" "first") settled)

28 (assert-equal 0 (mcp-client-pending-count client))))

30 (test "unknown response is observable"

31 (mcp-client-handle-message! client (make-response 999 '()))

32 (assert-equal 'orphan-response (assoc-ref 'type (car (reverse events))))))

34(test-group "lifecycle"

35 (test "initialize records negotiation and sends initialized"

36 (let* ((outcome #f)

37 (id (mcp-client-initialize!

38 client "2025-06-18"

39 '((name . "test") (version . "1"))

40 '()

41 (lambda (r) (set! outcome r)))))

42 (assert-equal 'initializing (mcp-client-state client))

43 (mcp-client-handle-message!

44 client

45 (make-response id

46 '((protocolVersion . "2025-06-18")

47 (capabilities . ((tools . ())))

48 (serverInfo . ((name . "fixture") (version . "1"))))))

49 (assert-true (jsonrpc-response? outcome))

50 (assert-equal 'ready (mcp-client-state client))

51 (assert-equal "2025-06-18" (mcp-client-protocol-version client))

52 (assert-equal "notifications/initialized"

53 (dict-ref (json-decode (car (reverse sent))) method:))))

55 (test "initialize records metadata decoded from a JSON frame"

56 (let* ((json-client

57 (mcp-client send: (lambda (_) #t)))

58 (id (mcp-client-initialize!

59 json-client "2025-06-18"

60 '((name . "test") (version . "1")) '() (lambda (_) #t))))

61 (mcp-client-handle-line!

62 json-client

63 (json-encode

64 #{ jsonrpc: "2.0" id: id

65 result: #{ protocolVersion: "2025-06-18"

66 capabilities: #{ resources: #{} }

67 serverInfo: #{ name: "fixture" version: "1" } } }))

68 (assert-equal "2025-06-18" (mcp-client-protocol-version json-client))

69 (assert-true

70 (dict? (mcp-client-server-capabilities json-client)))

71 (assert-true

72 (dict? (dict-ref (mcp-client-server-capabilities json-client)

73 resources: #f)))))

75 (test "server notification is typed and observable"

76 (mcp-client-handle-message!

77 client (make-notification "notifications/claude/channel" '((content . "hi"))))

78 (let ((event (car (reverse events))))

79 (assert-equal 'notification (assoc-ref 'type event))

80 (assert-equal "notifications/claude/channel" (assoc-ref 'method event)))))

82(test-group "bounds and cancellation"

83 (test "oversize line is refused before parsing"

84 (assert-false (mcp-client-handle-line! client (make-string 257 #\x)))

85 (assert-equal 'frame-refused (assoc-ref 'type (car (reverse events)))))

87 (test "cancellation names the request id"

88 (mcp-client-cancel! client 44)

89 (let* ((wire (json-decode (car (reverse sent))))

90 (params (dict-ref wire params:)))

91 (assert-equal "notifications/cancelled" (dict-ref wire method:))

92 (assert-equal 44 (dict-ref params requestId:)))))

94(test-group "MCP methods"

95 (test "tool and resource wrappers retain protocol values"

96 (mcp-client-list-tools! client "next-tools" (lambda (_) #t))

97 (let ((wire (json-decode (car (reverse sent)))))

98 (assert-equal "tools/list" (dict-ref wire method:))

99 (assert-equal "next-tools" (dict-ref (dict-ref wire params:) cursor:)))

100 (mcp-client-call-tool! client "folio.read" '((name . "note")) (lambda (_) #t))

101 (let ((wire (json-decode (car (reverse sent)))))

102 (assert-equal "tools/call" (dict-ref wire method:))

103 (assert-equal "folio.read" (dict-ref (dict-ref wire params:) name:)))

104 (mcp-client-list-resource-templates! client #f (lambda (_) #t))

105 (assert-equal "resources/templates/list"

106 (dict-ref (json-decode (car (reverse sent))) method:))

107 (mcp-client-read-resource! client "sigil://index" (lambda (_) #t))

108 (assert-equal "sigil://index"

109 (dict-ref (dict-ref (json-decode (car (reverse sent))) params:) uri:))))

110

111(run-tests)