test/test-mcp-error-isolation.sgl

1;;; Regression test for the MCP tool-dispatch error-isolation bug.

2;;;

3;;; Before the fix, a single tool-handler error poisoned in-process state

4;;; so that every subsequent response (error or success) serialised to the

5;;; literal string "#<object>", wedging the whole session.

6;;;

7;;; The test spawns the built folio binary, sends one tool/call that raises

8;;; (wrong argument key), then a valid tool/call. It asserts that both

9;;; responses are well-formed JSON — NOT the literal "#<object>" text.

10;;;

11;;; A SECOND regression is guarded here (see the "malformed note-patch"

12;;; group below): a tool whose handler actually RAISES (not merely a schema

13;;; rejection) once wedged the whole session with no response at all. The

14;;; malformed note-read case above is rejected at schema validation and never

15;;; reaches the handler, so it did NOT exercise the raising path. note-patch

16;;; on an existing note passes schema validation, then raises inside `map`

17;;; (parse-patch-entry, missing 'old'/'new'). On sigil 0.17.1 the exception

18;;; unwound through the async scheduler; a log/response write during unwind

19;;; aborted to an async prompt already unwound past, recursed, corrupted the

20;;; continuation ("car: expected pair"), and NO response was ever written —

21;;; the session hung until the client cancelled. Fixed in sigil 0.17.3

22;;; (ecd318755, prompt-tag-available? gate); folio must stay locked to >=0.17.3.

23;;;

24;;; Requires: build/release/bin/folio (or build/dev/bin/folio) to exist.

25

26(import (sigil test)

27 (sigil string)

28 (sigil io)

29 (sigil fs)

30 (sigil path)

31 (sigil json)

32 (sigil time)

33 (sigil process))

34

35(define (existing-folio-binary)

36 (let ((candidates (list "build/release/bin/folio"

37 "build/dev/bin/folio")))

38 (let loop ((rest candidates))

39 (cond

40 ((null? rest) #f)

41 ((file-exists? (car rest)) (car rest))

42 (else (loop (cdr rest)))))))

43

44(define (make-tmp-folio-root)

45 (let* ((base (or (getenv "TMPDIR") "/tmp"))

46 (root (string-append base "/folio-err-iso-"

47 (number->string (current-second)))))

48 (make-directory root)

49 root))

50

51(define (read-lines-until port n)

52 (let loop ((left n) (acc '()))

53 (if (zero? left)

54 (reverse acc)

55 (let ((line (read-line port)))

56 (if (eof-object? line)

57 (reverse acc)

58 (loop (- left 1) (cons line acc)))))))

59

60(define (send-line! port line)

61 (display line port)

62 (newline port)

63 (flush-output-port port))

64

65(define (poison-and-probe folio-binary)

66 (let* ((root (make-tmp-folio-root))

67 (_ (setenv! "FOLIO_ROOT" root))

68 (p (process-spawn folio-binary)))

69 (send-line! (process-stdin p)

70 (string-append

71 "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\","

72 "\"params\":{\"protocolVersion\":\"2025-11-25\","

73 "\"capabilities\":{}}}"))

74 (send-line! (process-stdin p)

75 "{\"jsonrpc\":\"2.0\",\"method\":\"notifications/initialized\"}")

76 ;; Malformed tool call: wrong key (path: instead of name:).

77 (send-line! (process-stdin p)

78 (string-append

79 "{\"jsonrpc\":\"2.0\",\"id\":2,\"method\":\"tools/call\","

80 "\"params\":{\"name\":\"folio/note-read\","

81 "\"arguments\":{\"path\":\"whatever.md\"}}}"))

82 ;; Follow-up valid call: folio/status with empty args.

83 (send-line! (process-stdin p)

84 (string-append

85 "{\"jsonrpc\":\"2.0\",\"id\":3,\"method\":\"tools/call\","

86 "\"params\":{\"name\":\"folio/status\",\"arguments\":{}}}"))

87 (close-output-port (process-stdin p))

88 (let ((lines (read-lines-until (process-stdout p) 3)))

89 (process-wait p)

90 lines)))

91

92;; Return #t if `line` is a JSON-RPC response whose result.content[0].text

93;; is the literal poisoned string "#<object>".

94(define (poisoned-response? line)

95 (string-contains? line "\"#<object>\""))

96

97(test-group "mcp tool-dispatch error isolation"

98 (let ((folio (existing-folio-binary)))

99 (cond

100 ((not folio)

101 (test "skipped: folio binary not built"

102 (assert-true #t)))

103 (else

104 (let ((lines (poison-and-probe folio)))

105 (test "got three response lines (init + poisoned + follow-up)"

106 (assert-equal 3 (length lines)))

107 (when (= (length lines) 3)

108 (let ((init-resp (list-ref lines 0))

109 (poison-resp (list-ref lines 1))

110 (followup (list-ref lines 2)))

111 (test "init response is well-formed"

112 (assert-true (string-contains? init-resp "\"protocolVersion\"")))

113 ;; The poisoned call may legitimately return an error envelope

114 ;; (preferred) or — acceptably for this test — a success envelope

115 ;; with a sensible text. What it MUST NOT return is "#<object>".

116 (test "poisoned tool call does not return #<object>"

117 (assert-false (poisoned-response? poison-resp)))

118 (test "follow-up valid tool call does not return #<object>"

119 (assert-false (poisoned-response? followup)))

120 (test "follow-up valid call has Folio Status content"

121 (assert-true (string-contains? followup "Folio Status"))))))))))

122

123;; Drive the binary through the RAISING-handler path: initialize, create a note,

124;; then send a malformed note-patch (patch entry missing 'old'/'new') so the

125;; handler raises inside `map`, then a valid follow-up. Returns the four response

126;; lines: initialize, note-create, note-patch (error), status. If the server

127;; wedges, read-line blocks and the test harness surfaces it as a hang rather

128;; than a pass.

129(define (patch-poison-and-probe folio-binary)

130 (let* ((root (make-tmp-folio-root))

131 (_ (setenv! "FOLIO_ROOT" root))

132 (p (process-spawn folio-binary)))

133 (send-line! (process-stdin p)

134 (string-append

135 "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\","

136 "\"params\":{\"protocolVersion\":\"2025-11-25\","

137 "\"capabilities\":{}}}"))

138 (send-line! (process-stdin p)

139 "{\"jsonrpc\":\"2.0\",\"method\":\"notifications/initialized\"}")

140 ;; Seed a real note so note-patch reaches its handler (find-note-file hits).

141 (send-line! (process-stdin p)

142 (string-append

143 "{\"jsonrpc\":\"2.0\",\"id\":2,\"method\":\"tools/call\","

144 "\"params\":{\"name\":\"folio/note-create\","

145 "\"arguments\":{\"name\":\"probe-note\","

146 "\"content\":\"Body line one. Body line two.\"}}}"))

147 ;; Malformed note-patch: patch entry has 'content' but no 'old'/'match',

148 ;; so parse-patch-entry raises. This is the RAISING-handler path.

149 (send-line! (process-stdin p)

150 (string-append

151 "{\"jsonrpc\":\"2.0\",\"id\":3,\"method\":\"tools/call\","

152 "\"params\":{\"name\":\"folio/note-patch\","

153 "\"arguments\":{\"name\":\"probe-note\","

154 "\"patches\":[{\"op\":\"append\",\"content\":\"x\"}]}}}"))

155 ;; Follow-up valid call: must succeed if the session stayed healthy.

156 (send-line! (process-stdin p)

157 (string-append

158 "{\"jsonrpc\":\"2.0\",\"id\":4,\"method\":\"tools/call\","

159 "\"params\":{\"name\":\"folio/status\",\"arguments\":{}}}"))

160 (close-output-port (process-stdin p))

161 (let ((lines (read-lines-until (process-stdout p) 4)))

162 (process-wait p)

163 lines)))

164

165(test-group "mcp malformed note-patch does not wedge the session"

166 (let ((folio (existing-folio-binary)))

167 (cond

168 ((not folio)

169 (test "skipped: folio binary not built"

170 (assert-true #t)))

171 (else

172 (let ((lines (patch-poison-and-probe folio)))

173 ;; Four responses (init, create, patch-error, status) prove the

174 ;; malformed note-patch neither hung nor swallowed later responses.

175 (test "got four response lines (no wedge/hang)"

176 (assert-equal 4 (length lines)))

177 (when (= (length lines) 4)

178 (let ((init-resp (list-ref lines 0))

179 (create-resp (list-ref lines 1))

180 (patch-resp (list-ref lines 2))

181 (status-resp (list-ref lines 3)))

182 (test "init response is well-formed"

183 (assert-true (string-contains? init-resp "\"protocolVersion\"")))

184 (test "note-create succeeded"

185 (assert-true (string-contains? create-resp "Created note")))

186 ;; The raising handler must serialise to a well-formed JSON-RPC

187 ;; error — never "#<object>", never a missing response.

188 (test "malformed note-patch returns a JSON-RPC error"

189 (assert-true (string-contains? patch-resp "\"error\"")))

190 (test "malformed note-patch error names the missing field"

191 (assert-true (string-contains? patch-resp "missing 'old'")))

192 (test "malformed note-patch does not return #<object>"

193 (assert-false (poisoned-response? patch-resp)))

194 ;; The session must remain fully healthy for the next call.

195 (test "follow-up valid call does not return #<object>"

196 (assert-false (poisoned-response? status-resp)))

197 (test "follow-up valid call has Folio Status content"

198 (assert-true (string-contains? status-resp "Folio Status"))))))))))