Improve verified local guardrails
ober
add42e731f09621d1a1cfb8006c92533b24f2741
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -230,6 +230,7 @@ ;; task guidance. Advertising discovery schemas contradicts that ;; guidance, increases prefill, and invites another inspection turn. ((and (current-verified-local-model?) + (not (current-verified-local-targeted-mcp?)) (verified-mcp-tool-spec? spec)) #f) ;; Requirements review is a local evidence check, not a new build or @@ -289,6 +290,7 @@ ;; models do better spending their two repair observations on the ;; implicated source than opening another MCP round-trip. ((and (current-verified-local-model?) + (not (current-verified-local-targeted-mcp?)) (current-after-failed-verify?) (verified-mcp-tool-spec? spec)) #f) @@ -1441,7 +1443,8 @@ "jerboa_eval")) (def *verified-compact-mcp-name-fragments* - '("jerboa_howto_get" + '("jerboa_cookbook_task_bundle" + "jerboa_howto_get" "jerboa_howto" "jerboa_apropos" "jerboa_module_exists" @@ -1460,7 +1463,8 @@ *verified-compact-mcp-name-fragments*)) (def *verified-targeted-after-failure-mcp-name-fragments* - '("jerboa_check_syntax" + '("jerboa_cookbook_task_bundle" + "jerboa_check_syntax" "jerboa_compile_check" "jerboa_failure_advisor" "jerboa_error_fix_lookup" @@ -1474,9 +1478,12 @@ (def (pre-edit-mcp-block-message name) (and (= (current-successful-edit-count) 0) - (let ((next (+ (current-pre-edit-mcp-count) 1))) + (let* ((limit (if (current-verified-local-targeted-mcp?) + local-targeted-pre-edit-mcp-limit + pre-edit-mcp-limit)) + (next (+ (current-pre-edit-mcp-count) 1))) (current-pre-edit-mcp-count next) - (and (> next pre-edit-mcp-limit) + (and (> next limit) (string-append "pre-edit MCP discovery limit reached while calling " name @@ -1757,9 +1764,18 @@ (def current-pre-edit-navigation-count (make-parameter 0)) +(def current-denied-read-scope-fingerprint + (make-parameter #f)) + +(def current-denied-read-scope-repeat-count + (make-parameter 0)) + (def current-verified-local-model? (make-parameter #f)) +(def current-verified-local-targeted-mcp? + (make-parameter #f)) + (def current-verify-failure-count (make-parameter 0)) @@ -1805,6 +1821,8 @@ (current-pre-edit-run-alias-count 0) (current-pre-edit-inspection-count 0) (current-pre-edit-navigation-count 0) + (current-denied-read-scope-fingerprint #f) + (current-denied-read-scope-repeat-count 0) (current-verify-failure-count 0) (current-force-expert-next? #f) (current-last-verify-detail #f) @@ -1817,6 +1835,8 @@ (def pre-edit-mcp-limit 2) +(def local-targeted-pre-edit-mcp-limit 1) + (def pre-edit-run-alias-limit 4) (def local-pre-edit-inspection-limit 6) @@ -2680,20 +2700,59 @@ (let ((roots (verified-read-roots cwd))) (and (pair? roots) (string-join roots ", ")))) +(def (denied-read-scope-signature cwd tool path) + (let ((rel (scope-path cwd path))) + (cond + ((not (outside-scope-path? rel)) #f) + ((read-root-allowed? cwd path) #f) + ((absolute-path-string? path) + (string-append tool "|absolute-external")) + ((string-prefix? "../" rel) + (string-append tool "|parent-external")) + (else + (string-append tool "|outside-external"))))) + +(def (record-denied-read-scope! cwd tool path) + (let ((sig (denied-read-scope-signature cwd tool path))) + (and sig + (let ((old (current-denied-read-scope-fingerprint))) + (if (and old (string=? old sig)) + (let ((n (+ (current-denied-read-scope-repeat-count) 1))) + (current-denied-read-scope-repeat-count n) + n) + (begin + (current-denied-read-scope-fingerprint sig) + (current-denied-read-scope-repeat-count 1) + 1)))))) + (def (read-scope-message cwd tool path) (let ((rel (scope-path cwd path))) (and (outside-scope-path? rel) (not (read-root-allowed? cwd path)) - (string-append - tool - " refused outside the verified working directory: " - path - ". Use read/list only for files under the current repo" - (let ((roots (read-roots-label cwd))) - (if roots - (string-append " or under the configured read-only roots (" roots ")") - "")) - ". If caller guidance permits external discovery, use MCP tools such as module_exports, apropos, howto, or cookbook_task_bundle for external Jerboa APIs; otherwise stay inside the current repo.")))) + (let ((repeat-count (record-denied-read-scope! cwd tool path))) + (string-append + tool + " refused outside the verified working directory: " + path + ". Use read/list only for files under the current repo" + (let ((roots (read-roots-label cwd))) + (if roots + (string-append " or under the configured read-only roots (" roots ")") + "")) + ". If caller guidance permits external discovery, use MCP tools such as module_exports, apropos, howto, or cookbook_task_bundle for external Jerboa APIs; otherwise stay inside the current repo." + (if (and repeat-count (> repeat-count 1)) + "\nRepeated external path attempts are a no-progress pattern even when the path spelling changes. Stop guessing filesystem locations; use an allowed read root, targeted MCP API lookup, or write the first complete draft and verify." + "")))))) + +(def (read-scope-result cwd tool-name tool-symbol path) + (let ((msg (read-scope-message cwd tool-name path))) + (and msg + (if (and (current-verified-local-model?) + (> (current-denied-read-scope-repeat-count) 1)) + (if (> (current-denied-read-scope-repeat-count) 2) + (raise-recoverable-tool-error msg tool-symbol) + msg) + msg)))) (def (read-roots-instruction cwd) (let ((roots (read-roots-label cwd))) @@ -2848,7 +2907,7 @@ (cond ((pending-ss-create-repair-message cwd) => (lambda (msg) (raise-recoverable-tool-error msg 'list))) - ((read-scope-message cwd "list" path) => (lambda (msg) msg)) + ((read-scope-result cwd "list" 'list path) => (lambda (msg) msg)) ((not (file-exists? p)) (string-append "(path does not exist: " path ")")) ((not (file-directory? p)) @@ -2893,7 +2952,7 @@ ((rejected-draft-read-message cwd path args) => (lambda (msg) msg)) ((pending-ss-create-repair-message cwd) => (lambda (msg) (raise-recoverable-tool-error msg 'read))) - ((read-scope-message cwd "read" path) => (lambda (msg) msg)) + ((read-scope-result cwd "read" 'read path) => (lambda (msg) msg)) ((not (file-exists? p)) (missing-file-observation path cwd)) ((file-directory? p) @@ -5345,6 +5404,10 @@ (run-aliases? (let ((p (assoc 'run-aliases? o))) (if p (cdr p) #f))) (local-model? (and (opt-get o 'local-model?) #t)) + (local-targeted-mcp? + (and local-model? + (or (and (opt-get o 'local-targeted-mcp?) #t) + (env-truthy? "JCODE_VERIFIED_LOCAL_TARGETED_MCP")))) (external-tools? (let ((p (assoc 'external-tools? o))) (if p (cdr p) #t))) (compact? (or (let ((p (assoc 'compact? o))) @@ -5356,7 +5419,7 @@ (external-tool-defs (if external-tools? (let ((defs (workflow-mcp-tool-defs cwd))) - (if compact? + (if (or compact? local-targeted-mcp?) (filter verified-compact-mcp-tool? defs) defs)) '()))) @@ -5580,7 +5643,9 @@ inspection-defs (list create-script-def) (if run-aliases? (list run-def bash-def shell-def) '()) - (if local-model? '() external-tool-defs) + (if (and local-model? (not local-targeted-mcp?)) + '() + external-tool-defs) (list edit-def write-def line-edit-def replace-def replace-range-def verify-def done-def)) (if terminal-on-verify? '() (list "verify")) (if terminal-on-verify? "verify" "done") @@ -5617,7 +5682,9 @@ " calls; then write the first complete draft and verify.\n") "run/bash/shell are not available in this workflow. Use verify for the configured build/test command.\n") "For a new Jerboa .ss script, create_verified_jerboa_script is optional. Use it only when one generic kind clearly matches: minimal-pass for trivial executable scripts, cli-two-args for simple numeric two-argument CLIs, and vector-grid for 2-D vector/grid examples. For nontrivial algorithms, write a small complete first version that parses and runs, verify it, then expand one function or data transformation at a time using verifier output.\n" - (if local-model? "" (external-tools-instruction external-tool-defs)) + (if (and local-model? (not local-targeted-mcp?)) + "" + (external-tools-instruction external-tool-defs)) (scope-instruction scope) (guidance-instruction task-guidance) (let ((expert-guidance (expert-prompt-instructions))) @@ -5632,7 +5699,9 @@ "3. verify to run the configured build/tests; `verify()` is the behavioral authority.\n" "3. verify to run the configured build/tests. For executable CLI scripts that require args or stdin, use MCP verifiers only as syntax/API sanity checks; `verify()` is the behavioral authority.\n") (if local-model? - "4. If verify fails, read the error, make the smallest implicated code edit, and verify again. MCP tools are unavailable in local-model verified sessions.\n" + (if local-targeted-mcp? + "4. If verify fails, read the error, make the smallest implicated code edit, and verify again. Targeted read-only MCP tools may be used only for exact dependency/API facts named by the task or verifier.\n" + "4. If verify fails, read the error, make the smallest implicated code edit, and verify again. MCP tools are unavailable in local-model verified sessions.\n") "4. If verify fails, read the error, make the smallest implicated code edit, and verify again. Do not call broad discovery/MCP tools before that repair unless the failure is a missing API or syntax question.\n") (if terminal-on-verify? "5. A passing verify completes the run. You cannot finish on unverified code." @@ -5640,6 +5709,142 @@ "5. After verify passes, perform one requirements review against the full caller task, including validation and edge cases the tests may omit. Fix any gap and verify again; otherwise call done. Any edit invalidates the prior pass." "5. Only call done AFTER verify has passed. You cannot finish on unverified code.")))))))) +;; ── final policy check ───────────────────────────────────────────────── +;; Verified tasks can pass their command while still changing benchmark seeds +;; or leaving generated artifacts. These env hooks make that impossible for +;; harnesses that need an honest final diff. +(def *final-policy-missing* (list 'missing)) +(def *final-policy-directory* (list 'directory)) +(def *final-policy-unreadable* (list 'unreadable)) + +(def (split-policy-paths raw) + (if (and raw (not (string=? raw ""))) + (filter (lambda (s) (not (string=? s ""))) + (map string-trim + (apply append + (map (lambda (part) (string-split part #\,)) + (string-split raw #\:))))) + '())) + +(def (policy-env-paths names) + (let loop ((xs names) (acc '())) + (if (null? xs) + (reverse acc) + (loop (cdr xs) + (append (reverse (split-policy-paths (getenv (car xs)))) acc))))) + +(def (unique-strings xs) + (let loop ((rest xs) (seen '()) (acc '())) + (cond + ((null? rest) (reverse acc)) + ((member (car rest) seen) (loop (cdr rest) seen acc)) + (else (loop (cdr rest) (cons (car rest) seen) (cons (car rest) acc)))))) + +(def (policy-abs-path cwd path) + (abs-path cwd (expand-home-path path))) + +(def (safe-read-policy-file path) + (guard (e [else *final-policy-unreadable*]) + (read-file-string path))) + +(def (final-policy-snapshot-tree path) + (cond + ((not (file-exists? path)) + (list (cons path *final-policy-missing*))) + ((file-directory? path) + (let ((children + (list-sort string<? + (map (lambda (entry) + (string-append + (if (string-suffix? "/" path) + path + (string-append path "/")) + entry)) + (directory-list path))))) + (cons (cons path *final-policy-directory*) + (let ((snapshots (map final-policy-snapshot-tree children))) + (if (null? snapshots) '() (apply append snapshots)))))) + (else + (list (cons path (safe-read-policy-file path)))))) + +(def (final-policy-existing-tree path) + (if (file-exists? path) + (final-policy-snapshot-tree path) + '())) + +(def (final-policy-snapshot cwd) + (let* ((immutable + (unique-strings + (policy-env-paths + '("JCODE_VERIFIED_IMMUTABLE_PATHS" "JCODE_IMMUTABLE_PATHS")))) + (forbidden + (unique-strings + (policy-env-paths + '("JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS" + "JCODE_FORBIDDEN_ADDED_PATHS"))))) + (and (or (pair? immutable) (pair? forbidden)) + (list + (cons 'immutable + (map (lambda (path) + (let ((abs (policy-abs-path cwd path))) + (cons path (final-policy-snapshot-tree abs)))) + immutable)) + (cons 'forbidden + (map (lambda (path) + (let ((abs (policy-abs-path cwd path))) + (cons path (final-policy-existing-tree abs)))) + forbidden)))))) + +(def (snapshot-ref snapshot key) + (let ((p (assoc key snapshot))) + (if p (cdr p) '()))) + +(def (changed-immutable-paths snapshot cwd) + (let loop ((items (snapshot-ref snapshot 'immutable)) (acc '())) + (cond + ((null? items) (reverse acc)) + (else + (let* ((path (caar items)) + (before (cdar items)) + (after (final-policy-snapshot-tree (policy-abs-path cwd path)))) + (loop (cdr items) + (if (equal? before after) acc (cons path acc)))))))) + +(def (new-forbidden-paths snapshot cwd) + (let loop ((items (snapshot-ref snapshot 'forbidden)) (acc '())) + (cond + ((null? items) (reverse acc)) + (else + (let* ((path (caar items)) + (before (cdar items)) + (after (final-policy-existing-tree (policy-abs-path cwd path))) + (added + (filter (lambda (entry) (not (member entry before))) after))) + (loop (cdr items) + (if (pair? added) (cons path acc) acc))))))) + +(def (final-policy-error snapshot cwd) + (and snapshot + (let ((changed (changed-immutable-paths snapshot cwd)) + (added (new-forbidden-paths snapshot cwd))) + (and (or (pair? changed) (pair? added)) + (string-append + "final policy refused verified result:" + (if (pair? changed) + (string-append " immutable path changed: " + (string-join changed ", ") ".") + "") + (if (pair? added) + (string-append " forbidden path was added or changed: " + (string-join added ", ") ".") + "")))))) + +(def (enforce-final-policy! snapshot cwd) + (cond + ((final-policy-error snapshot cwd) + => (lambda (msg) (error 'verified-final-policy msg))) + (else #t))) + ;; ── entry point ───────────────────────────────────────────────────────── ;; Run TASK against PROVIDER through the verified-coding workflow. OPT assoc: ;; verify-command (default "make build") cwd (default ".") @@ -5653,6 +5858,10 @@ (def (verified-run provider task . opt) (let* ((o (if (pair? opt) (car opt) '())) (local-model? (and (opt-get o 'local-model?) #t)) + (local-targeted-mcp? + (and local-model? + (or (and (opt-get o 'local-targeted-mcp?) #t) + (env-truthy? "JCODE_VERIFIED_LOCAL_TARGETED_MCP")))) (vcmd (or (opt-get o 'verify-command) default-verify-command)) (cwd (or (opt-get o 'cwd) ".")) (k (or (opt-get o 'best-of) 1)) @@ -5671,12 +5880,14 @@ (combine-task-guidance (verified-preflight-guidance task cwd vcmd scope) (opt-get o 'task-guidance))) + (policy-snapshot (final-policy-snapshot cwd)) (wf (coding-workflow vcmd cwd (list (cons 'write-scope scope) (cons 'run-aliases? (let ((p (assoc 'run-aliases? o))) (if p (cdr p) #f))) (cons 'local-model? local-model?) + (cons 'local-targeted-mcp? local-targeted-mcp?) (cons 'task-guidance task-guidance) (cons 'compact? (and (opt-get o 'compact?) #t)) (cons 'review-after-verify? @@ -5746,6 +5957,7 @@ (current-pre-edit-inspection-count 0) (current-pre-edit-navigation-count 0) (current-verified-local-model? local-model?) + (current-verified-local-targeted-mcp? local-targeted-mcp?) (current-max-tokens-cap (and local-model? (local-verified-first-draft-cap))) @@ -5756,11 +5968,14 @@ (current-required-range-repair #f) (current-required-repair-inspections 0)) (reset-verified-attempt-state!) - (if (> k 1) - (run-best-of-k - wf task - (lambda () - (reset-verified-attempt-state!) - (provider-responder provider)) - k ropt) - (run-workflow wf task (provider-responder provider) ropt))))) + (let ((summary + (if (> k 1) + (run-best-of-k + wf task + (lambda () + (reset-verified-attempt-state!) + (provider-responder provider)) + k ropt) + (run-workflow wf task (provider-responder provider) ropt)))) + (enforce-final-policy! policy-snapshot cwd) + summary)))) --- a/test/run.ss +++ b/test/run.ss @@ -2676,6 +2676,104 @@ (safe-delete-test-file! vr-path)) (let* ([vr-dir "/tmp"] + [seed "jcode-verified-policy-seed.txt"] + [target "jcode-verified-policy-target.txt"] + [seed-path (string-append vr-dir "/" seed)] + [target-path (string-append vr-dir "/" target)] + [old-immutable (getenv "JCODE_VERIFIED_IMMUTABLE_PATHS")] + [old-forbidden (getenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS")]) + (safe-delete-test-file! seed-path) + (safe-delete-test-file! target-path) + (write-test-output-file seed-path + (lambda (o) (display "seed\n" o)) + 'replace) + (dynamic-wind + (lambda () + (putenv "JCODE_VERIFIED_IMMUTABLE_PATHS" seed) + (putenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS" "")) + (lambda () + (let* ([resp (scripted-responder + (list + (list (make-wtool-call "edit" + (list (cons "path" seed) + (cons "content" "changed\n")) #f)) + (list (make-wtool-call "edit" + (list (cons "path" target) + (cons "content" "ok\n")) #f)) + (list (make-wtool-call "verify" '() #f))))] + [err + (condition->string + (lambda () + (verified-run resp "immutable policy catches seed edit" + (list + (cons 'cwd vr-dir) + (cons 'verify-command + (string-append "grep -q ok " target)) + (cons 'write-scope + (parse-write-scope (string-append seed "," target))) + (cons 'max-iterations 6) + (cons 'max-tool-errors 0)))))]) + (check-pred! "verified-run: final policy rejects immutable change" + err + (lambda (s) + (and (str-contains? s "final policy refused") + (str-contains? s "immutable path changed") + (str-contains? s seed)))))) + (lambda () + (putenv "JCODE_VERIFIED_IMMUTABLE_PATHS" (or old-immutable "")) + (putenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS" (or old-forbidden "")))) + (safe-delete-test-file! seed-path) + (safe-delete-test-file! target-path)) + +(let* ([vr-dir "/tmp"] + [forbidden "jcode-verified-policy-forbidden.txt"] + [forbidden-path (string-append vr-dir "/" forbidden)] + [target "jcode-verified-policy-ok.txt"] + [target-path (string-append vr-dir "/" target)] + [old-immutable (getenv "JCODE_VERIFIED_IMMUTABLE_PATHS")] + [old-forbidden (getenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS")]) + (safe-delete-test-file! forbidden-path) + (safe-delete-test-file! target-path) + (dynamic-wind + (lambda () + (putenv "JCODE_VERIFIED_IMMUTABLE_PATHS" "") + (putenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS" forbidden)) + (lambda () + (let* ([resp (scripted-responder + (list + (list (make-wtool-call "edit" + (list (cons "path" forbidden) + (cons "content" "artifact\n")) #f)) + (list (make-wtool-call "edit" + (list (cons "path" target) + (cons "content" "ok\n")) #f)) + (list (make-wtool-call "verify" '() #f))))] + [err + (condition->string + (lambda () + (verified-run resp "forbidden final artifact is rejected" + (list + (cons 'cwd vr-dir) + (cons 'verify-command + (string-append "grep -q ok " target)) + (cons 'write-scope + (parse-write-scope + (string-append forbidden "," target))) + (cons 'max-iterations 6) + (cons 'max-tool-errors 0)))))]) + (check-pred! "verified-run: final policy rejects forbidden add" + err + (lambda (s) + (and (str-contains? s "final policy refused") + (str-contains? s "forbidden path") + (str-contains? s forbidden)))))) + (lambda () + (putenv "JCODE_VERIFIED_IMMUTABLE_PATHS" (or old-immutable "")) + (putenv "JCODE_VERIFIED_FORBIDDEN_ADDED_PATHS" (or old-forbidden "")))) + (safe-delete-test-file! forbidden-path) + (safe-delete-test-file! target-path)) + +(let* ([vr-dir "/tmp"] [target "jcode-verified-best-of-state.ss"] [target-path (string-append vr-dir "/" target)] [bad "(import (jerboa prelude))\n(def (broken)\n"] @@ -3219,6 +3317,56 @@ (safe-delete-test-file! target-path)) (let* ([vr-dir "/tmp"] + [target "jcode-verified-local-targeted-mcp-budget.txt"] + [target-path (string-append vr-dir "/" target)] + [tool-results '()]) + (safe-delete-test-file! target-path) + (register-tool! "jerboa_cookbook_task_bundle" + "Qt bundle" + '(("type" . "object")) + (lambda (a) "compact qt bundle")) + (set-tool-origin! "jerboa_cookbook_task_bundle" 'mcp) + (let* ([resp + (scripted-responder + (list + (list (make-wtool-call "jerboa_cookbook_task_bundle" + (list (cons "task" "Qt Tetris")) #f)) + (list (make-wtool-call "jerboa_cookbook_task_bundle" + (list (cons "task" "Qt Tetris again")) #f)) + (list (make-wtool-call "edit" + (list (cons "path" target) + (cons "content" "fixed\n")) #f)) + (list (make-wtool-call "verify" '() #f))))] + [result + (verified-run resp "local targeted MCP budget" + (list + (cons 'cwd vr-dir) + (cons 'verify-command (string-append "grep -q fixed " target)) + (cons 'write-scope (parse-write-scope target)) + (cons 'local-model? #t) + (cons 'local-targeted-mcp? #t) + (cons 'max-iterations 8) + (cons 'max-tool-errors 0) + (cons 'on-message + (lambda (m) + (when (equal? (message-role m) "tool") + (set! tool-results + (cons (message-content m) tool-results)))))))]) + (check! "verified-run: local targeted MCP budget still reaches verify" + result "VERIFIED: exit 0\n") + (check-pred! "verified-run: local targeted MCP refuses second pre-edit call" + (reverse tool-results) + (lambda (xs) + (let loop ([ys xs]) + (cond + [(null? ys) #f] + [(and (str-contains? (car ys) "[ToolRecoverableError]") + (str-contains? (car ys) + "pre-edit MCP discovery limit reached")) #t] + [else (loop (cdr ys))]))))) + (safe-delete-test-file! target-path)) + + (let* ([vr-dir "/tmp"] [target "jcode-local-rejected-draft-escalation.ss"] [target-path (string-append vr-dir "/" target)] [bad1 "(import (jerboa prelude))\n(def (main) (displayln \"one\")))\n"] @@ -4302,6 +4450,55 @@ (str-contains? s "list refused outside")))))) (lambda () (putenv "JCODE_READ_ROOTS" (or old-read-roots ""))))) +(let ([old-read-roots (getenv "JCODE_READ_ROOTS")]) + (dynamic-wind + (lambda () (putenv "JCODE_READ_ROOTS" "")) + (lambda () + (let* ([vr-dir "/tmp/jcode-verified-denied-loop"] + [target "done.txt"] + [target-path (string-append vr-dir "/" target)] + [tool-results '()] + [resp + (scripted-responder + (list + (list (make-wtool-call "read" '(("path" . "/tmp")) #f)) + (list (make-wtool-call "read" '(("path" . "/var")) #f)) + (list (make-wtool-call "read" '(("path" . "/etc")) #f)) + (list (make-wtool-call "edit" + (list (cons "path" target) + (cons "content" "ok\n")) #f)) + (list (make-wtool-call "verify" '() #f))))]) + (ensure-test-directory! vr-dir) + (safe-delete-test-file! target-path) + (let ([result + (verified-run resp "stop denied external read loop" + (list + (cons 'cwd vr-dir) + (cons 'verify-command (string-append "grep -q ok " target)) + (cons 'write-scope (parse-write-scope target)) + (cons 'local-model? #t) + (cons 'max-iterations 8) + (cons 'max-tool-errors 0) + (cons 'on-message + (lambda (m) + (when (equal? (message-role m) "tool") + (set! tool-results + (cons (message-content m) tool-results)))))))]) + (check! "verified-run: denied external read loop can recover" + result "VERIFIED: exit 0\n") + (check-pred! "verified-run: normalized denied paths become recoverable" + (reverse tool-results) + (lambda (xs) + (let loop ([ys xs]) + (cond + [(null? ys) #f] + [(and (str-contains? (car ys) "[ToolRecoverableError]") + (str-contains? (car ys) "Repeated external path attempts") + (str-contains? (car ys) "no-progress pattern")) #t] + [else (loop (cdr ys))]))))) + (safe-delete-test-file! target-path))) + (lambda () (putenv "JCODE_READ_ROOTS" (or old-read-roots ""))))) + (let* ([cwd "/tmp/jcode-verified-read-scope"] [root "/tmp/jcode-verified-read-root"] [external-file (string-append root "/api.ss")] @@ -4517,6 +4714,16 @@ '(("type" . "object")) (lambda (a) "recipe")) (set-tool-origin! "jerboa_howto_get" 'mcp) + (register-tool! "jerboa_cookbook_task_bundle" + "A compact dependency/task context bundle reader." + '(("type" . "object")) + (lambda (a) "bundle")) + (set-tool-origin! "jerboa_cookbook_task_bundle" 'mcp) + (register-tool! "jerboa_function_signature" + "A compact-mode allowed MCP function signature reader." + '(("type" . "object")) + (lambda (a) "signature")) + (set-tool-origin! "jerboa_function_signature" 'mcp) (register-tool! "jerboa_balanced_replace" "A write-capable MCP replace tool that should not bypass jcode edits." '(("type" . "object")) @@ -4528,7 +4735,12 @@ [disabled-wf (coding-workflow "true" "/tmp" (list (cons 'external-tools? #f)))] [compact-wf (coding-workflow "true" "/tmp" - (list (cons 'compact? #t)))]) + (list (cons 'compact? #t)))] + [local-default-wf (coding-workflow "true" "/tmp" + (list (cons 'local-model? #t)))] + [local-targeted-wf (coding-workflow "true" "/tmp" + (list (cons 'local-model? #t) + (cons 'local-targeted-mcp? #t)))]) (check! "verified-run: MCP-origin custom prefix is exposed" (and mcp-tool #t) #t) (check! "verified-run: plain registry tool is not exposed" @@ -4545,8 +4757,20 @@ (workflow-get-tool-def disabled-wf "jerboa_test_lookup") #f) (check! "verified-run: compact MCP keeps cookbook reader" (and (workflow-get-tool-def compact-wf "jerboa_howto_get") #t) #t) + (check! "verified-run: compact MCP keeps task bundle" + (and (workflow-get-tool-def compact-wf "jerboa_cookbook_task_bundle") #t) #t) (check! "verified-run: compact MCP hides broad lookup" (workflow-get-tool-def compact-wf "jerboa_test_lookup") #f) + (check! "verified-run: local model hides MCP by default" + (workflow-get-tool-def local-default-wf "jerboa_howto_get") #f) + (check! "verified-run: local targeted MCP keeps task bundle" + (and (workflow-get-tool-def local-targeted-wf "jerboa_cookbook_task_bundle") #t) #t) + (check! "verified-run: local targeted MCP keeps function signature" + (and (workflow-get-tool-def local-targeted-wf "jerboa_function_signature") #t) #t) + (check! "verified-run: local targeted MCP hides broad lookup" + (workflow-get-tool-def local-targeted-wf "jerboa_test_lookup") #f) + (check! "verified-run: local targeted MCP hides writer" + (workflow-get-tool-def local-targeted-wf "jerboa_howto_add") #f) (check! "verified-run: compact mode keeps canonical read" (and (workflow-get-tool-def compact-wf "read") #t) #t) (check! "verified-run: compact mode keeps canonical list"