test/test-unknown-args.sgl

1;;; Regression tests for note-edit silently replacing a note's body.

2;;;

3;;; note-edit ignored arguments it did not know. `{mode: "append", content: X}`

4;;; fell through to the `content` branch and replaced the whole body with X,

5;;; reporting "Updated note". Three notes lost their bodies this way. Every

6;;; tool now rejects arguments outside its schema, and every schema says so.

7;;;

8;;; The MCP groups drive the built binary: build/release/bin/folio, else

9;;; build/dev/bin/folio, unless FOLIO_TEST_BINARY names one. Logs go to a file

10;;; because nothing reads the child's stderr, and a full stderr pipe blocks it.

12(import (sigil test)

13 (sigil string)

14 (sigil io)

15 (sigil fs)

16 (sigil path)

17 (sigil json)

18 (sigil dict)

19 (sigil time)

20 (sigil random)

21 (sigil process))

23(define (folio-binary)

24 (or (getenv "FOLIO_TEST_BINARY")

25 (let loop ((rest (list "build/release/bin/folio" "build/dev/bin/folio")))

26 (cond

27 ((null? rest) #f)

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

29 (else (loop (cdr rest)))))))

31(define (make-root label)

32 (let ((root (string-append (or (getenv "TMPDIR") "/tmp")

33 "/folio-write-safety-" label "-"

34 (number->string (current-second)) "-"

35 (number->string (random-integer 1000000000)))))

36 (make-directory root)

37 (make-directory (path-join root "notes"))

38 (make-directory (path-join root "projects"))

39 (make-directory (path-join root "archive"))

40 (make-directory (path-join root "archive" "projects"))

41 (make-directory (path-join root "archive" "notes"))

42 (write-file-string (path-join root "inbox.md") "")

43 root))

45(define (big-body n)

46 (let loop ((i 0) (acc '()))

47 (if (= i n)

48 (string-join (reverse acc) "\n")

49 (loop (+ i 1)

50 (cons (string-append "Line " (number->string i)

51 " of a note long enough that rewriting it is not instant.")

52 acc)))))

54(define (seed-note! root name body)

55 (let ((path (path-join root "notes" (string-append name ".md"))))

56 (write-file-string path

57 (string-append "---\ntags:\n - topic\ncreated: 2026-01-01\n---\n\n# " name "\n\n"

58 body "\n\nTAIL-SENTINEL\n"))

59 path))

61(define (rpc id method params-json)

62 (string-append "{\"jsonrpc\":\"2.0\",\"id\":" (number->string id)

63 ",\"method\":\"" method "\",\"params\":" params-json "}"))

65(define (tool-call id tool args-json)

66 (rpc id "tools/call"

67 (string-append "{\"name\":\"folio/" tool "\",\"arguments\":" args-json "}")))

69(define (spawn-folio root)

70 (setenv! "FOLIO_ROOT" root)

71 (let ((p (process-spawn (folio-binary) "serve" "--log" (path-join root "folio-test.log"))))

72 (send! p (rpc 1 "initialize" "{\"protocolVersion\":\"2025-11-25\",\"capabilities\":{}}"))

73 (send! p "{\"jsonrpc\":\"2.0\",\"method\":\"notifications/initialized\"}")

74 p))

76(define (send! p line)

77 (display line (process-stdin p))

78 (newline (process-stdin p))

79 (flush-output-port (process-stdin p)))

81(define (finish! p n)

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

83 (collect! p n))

85(define (collect! p n)

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

87 (if (zero? left)

88 (begin (process-wait p) (reverse acc))

89 (let ((line (read-line (process-stdout p))))

90 (if (eof-object? line)

91 (begin (process-wait p) (reverse acc))

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

94(define (run-calls root calls)

95 (let ((p (spawn-folio root)))

96 (let loop ((cs calls) (id 2))

97 (unless (null? cs)

98 (send! p (tool-call id (car (car cs)) (cdr (car cs))))

99 (loop (cdr cs) (+ id 1))))

100 (let ((lines (finish! p (+ 1 (length calls)))))

101 (if (pair? lines) (cdr lines) '()))))

102

103(define (error-response? line)

104 (string-contains? line "\"error\""))

105

106(define rejected-calls

107 (list (list "mode + content" "note-edit"

108 "\"mode\":\"append\",\"content\":\"\\n\\n## New section\\n\"")

109 (list "operation + content" "note-edit"

110 "\"operation\":\"append\",\"content\":\"\\n\\n## New section\\n\"")

111 (list "content together with append" "note-edit"

112 "\"content\":\"X\",\"append\":\"Y\"")

113 (list "a patch entry with operation append" "note-patch"

114 "\"patches\":[{\"old\":\"Line 7 \",\"new\":\"Z\",\"operation\":\"append\"}]")

115 (list "a patch entry with an unknown key" "note-patch"

116 "\"patches\":[{\"old\":\"Line 7 \",\"new\":\"Z\",\"section\":\"S\"}]")

117 (list "a read tool with an unknown argument" "note-read"

118 "\"format\":\"raw\"")))

119

120(test-group "tools refuse arguments they do not know"

121 (if (not (folio-binary))

122 (test "skipped: folio binary not built" (assert-true #t))

123 (let* ((root (make-root "unknown-args"))

124 (names (map (lambda (i) (string-append "big" (number->string i)))

125 (iota (length rejected-calls))))

126 (paths (map (lambda (n) (seed-note! root n (big-body 400))) names))

127 (befores (map read-file-string paths))

128 (responses

129 (run-calls root

130 (let zip ((cs rejected-calls) (ns names) (acc '()))

131 (if (null? cs)

132 (reverse acc)

133 (zip (cdr cs) (cdr ns)

134 (cons (cons (cadr (car cs))

135 (string-append "{\"name\":\"" (car ns) "\"," (caddr (car cs)) "}"))

136 acc)))))))

137 (test "every call got a response"

138 (assert-equal (length rejected-calls) (length responses)))

139 (let loop ((cs rejected-calls) (rs responses) (ps paths) (bs befores))

140 (unless (or (null? cs) (null? rs))

141 (test (string-append (car (car cs)) " is an error")

142 (assert-true (error-response? (car rs))))

143 (test (string-append (car (car cs)) " leaves its note byte-identical")

144 (assert-equal (car bs) (read-file-string (car ps))))

145 (loop (cdr cs) (cdr rs) (cdr ps) (cdr bs))))

146 (test "the error names the unknown argument"

147 (assert-true (string-contains? (car responses) "Unknown argument for folio/note-edit: mode"))))))

148

149(test-group "the accepted forms still work"

150 (if (not (folio-binary))

151 (test "skipped: folio binary not built" (assert-true #t))

152 (let* ((root (make-root "accepted"))

153 (path (seed-note! root "small" "Alpha. Beta."))

154 (responses

155 (run-calls root

156 (list (cons "note-edit" "{\"name\":\"small\",\"append\":\"\\nAPPENDED\\n\"}")

157 (cons "note-patch" "{\"name\":\"small\",\"patches\":[{\"old\":\"Alpha.\",\"new\":\"Gamma.\"}]}")

158

                       (cons "note-patch" "{\"name\":\"small\",\"patches\":[{\"match\":\"Beta.\",\"content\":\"Delta.\",\"operation\":\"replace\"}]}")))))

159 (test "append succeeds"

160 (assert-false (error-response? (list-ref responses 0))))

161 (test "old/new patch succeeds"

162 (assert-false (error-response? (list-ref responses 1))))

163 (test "match/content patch with operation replace succeeds"

164 (assert-false (error-response? (list-ref responses 2))))

165 (test "all three edits are on disk"

166 (let ((after (read-file-string path)))

167 (assert-true (and (string-contains? after "APPENDED")

168 (string-contains? after "Gamma.")

169 (string-contains? after "Delta."))))))))

170

171(test-group "every tool schema is closed"

172 (if (not (folio-binary))

173 (test "skipped: folio binary not built" (assert-true #t))

174 (let* ((root (make-root "schemas"))

175 (p (spawn-folio root)))

176 (send! p (rpc 2 "tools/list" "{}"))

177 (let* ((lines (finish! p 2))

178 (tools (dict-ref (dict-ref (json-decode (list-ref lines 1)) result:) tools:))

179 (tools (if (list? tools) tools (array->list tools)))

180 (open-tools (filter (lambda (t)

181 (not (eq? #f (dict-ref (dict-ref t inputSchema:)

182 additionalProperties: 'absent))))

183 tools)))

184 (test "tools/list returned tools"

185 (assert-true (> (length tools) 20)))

186 (test "no tool accepts additional properties"

187 (assert-equal '() (map (lambda (t) (dict-ref t name:)) open-tools)))))))

188

189

190(test-group "metadata arguments the handlers read are declared"

191 (if (not (folio-binary))

192 (test "skipped: folio binary not built" (assert-true #t))

193 (let* ((root (make-root "metadata"))

194 (responses

195 (run-calls root

196

                 (list (cons "inbox-add" "{\"text\":\"from inbox\",\"source\":\"chat\",\"ref\":\"org/repo#1\",\"priority\":\"high\",\"due\":\"2026-10-01\",\"tags\":\"a b\"}")

197

                       (cons "task-add" "{\"text\":\"from task-add\",\"source\":\"github\",\"ref\":\"org/repo#2\",\"priority\":\"low\"}"))))

198 (inbox (read-file-string (path-join root "inbox.md"))))

199 (test "inbox-add with every metadata field succeeds"

200 (assert-false (error-response? (car responses))))

201 (test "task-add with source and ref succeeds"

202 (assert-false (error-response? (cadr responses))))

203 (test "the metadata is stored"

204 (assert-true (and (string-contains? inbox "priority: high")

205 (string-contains? inbox "source: github")

206 (string-contains? inbox "ref: org/repo#2")))))))

207

208

209(test-group "newly declared arguments still refuse tool-call markup"

210 (if (not (folio-binary))

211 (test "skipped: folio binary not built" (assert-true #t))

212 (let* ((root (make-root "markup"))

213 (responses

214 (run-calls root

215 (list (cons "task-add" "{\"text\":\"t\",\"source\":\"</text>\\n<parameter name=\\\"x\\\">\"}")

216 (cons "task-add" "{\"text\":\"t\",\"ref\":\"</parameter>\"}")

217 (cons "inbox-add" "{\"text\":\"t\",\"priority\":\"</text>\"}"))))

218 (inbox (read-file-string (path-join root "inbox.md"))))

219 (test "every one was refused"

220 (assert-equal 3 (length (filter (lambda (r) (string-contains? r "markup")) responses))))

221 (test "nothing was stored"

222 (assert-false (string-contains? inbox "</"))))))