Harden verified repair workflow
ober
7a5a532da9ff081e7016af7b60c017b3492ff288
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -614,6 +614,15 @@ (string-has-any? (tool-def-name tool-def) *verified-compact-mcp-name-fragments*)) +(def *verified-targeted-after-failure-mcp-name-fragments* + '("jerboa_check_syntax" + "jerboa_compile_check" + "jerboa_failure_advisor" + "jerboa_error_fix_lookup")) + +(def (verified-targeted-after-failure-mcp-tool? name) + (string-has-any? name *verified-targeted-after-failure-mcp-name-fragments*)) + (def (pre-edit-mcp-block-message name) (and (= (current-successful-edit-count) 0) (let ((next (+ (current-pre-edit-mcp-count) 1))) @@ -624,6 +633,11 @@ name ". Stop routing to MCP/API discovery. The next useful tool must be read/list on the current repo if a local file is still unknown, or edit/write with the first complete draft. After a successful edit and verify failure, use targeted MCP only for concrete syntax/API questions."))))) +(def (post-failed-verify-mcp-block-message name) + (and (current-after-failed-verify?) + (not (verified-targeted-after-failure-mcp-tool? name)) + (note-inspection-after-failed-verify! 'mcp))) + (def (env-truthy? name) (let ((v (getenv name))) (and v @@ -653,6 +667,14 @@ (or (rejected-draft-hard-recovery-message cwd name) (let ((msg (pre-edit-mcp-block-message name))) (and msg (error 'mcp msg))) + (let ((msg (post-failed-verify-mcp-block-message name))) + (and msg + (error 'mcp + (string-append + msg + "\nBlocked broad MCP tool: " + name + ". Use targeted syntax/failure tools only if the verifier output names an API or syntax uncertainty.")))) (tool-execute name (workflow-args->hash args)))) '()))))) (get-tool-schemas))) @@ -2658,10 +2680,12 @@ (let ((p (abs-path cwd target))) (unless (dir-scope-allowed? cwd target) (error 'run - "mkdir refused outside write scope: ~a" target)) + (format "mkdir refused outside write scope: ~a" + target))) (when (path-has-symlink-component? cwd target) (error 'run - "mkdir refused through symlink path component: ~a" target)) + (format "mkdir refused through symlink path component: ~a" + target))) (mkdir-p p))) targets) (string-append "mkdir alias created/confirmed: " @@ -2924,6 +2948,25 @@ ((balance-guard-message path content) => (lambda (msg) msg)) (else #f))))) +(def (placeholder-only-content? content) + (and (string? content) + (let ((s (string-trim content))) + (or (string=? s "...") + (string=? s "…"))))) + +(def (placeholder-edit-message tool path) + (string-append + (symbol->string tool) + " refused placeholder-only content" + (if path (string-append " for " path) "") + ". Do not write literal ellipses or abbreviated code. Send the complete corrected code for the target span, function, line, or file, then call verify.")) + +(def (guard-placeholder-content! tool path content) + (when (placeholder-only-content? content) + (raise-recoverable-tool-error + (placeholder-edit-message tool path) + tool))) + (def (guard-jerboa-syntax! path content (record-pending? #t)) (let ((msg (jerboa-syntax-guard-message path content))) (when msg @@ -3070,19 +3113,23 @@ ((not path) (error 'replace_def "missing path arg")) ((not name) (error 'replace_def "missing name arg")) ((not content) (error 'replace_def "missing content arg")) + ((placeholder-only-content? content) + (guard-placeholder-content! 'replace_def path content)) ((rejected-draft-hard-recovery-message cwd 'replace_def) => (lambda (msg) msg)) ((required-repair-tool-block-message cwd 'replace_def args) => (lambda (msg) msg)) (else (let ((p (abs-path cwd path))) (unless (file-exists? p) - (error 'replace_def "target does not exist: ~a" path)) + (error 'replace_def (format "target does not exist: ~a" path))) (let* ((old-content (read-file-string p)) (start (definition-start-index old-content name))) (unless start - (error 'replace_def "definition not found: ~a in ~a" name path)) + (error 'replace_def + (format "definition not found: ~a in ~a" name path))) (let ((end (form-end-index old-content start))) (unless end - (error 'replace_def "definition is unbalanced: ~a in ~a" name path)) + (error 'replace_def + (format "definition is unbalanced: ~a in ~a" name path))) (do-edit (list (cons "path" path) (cons "old_str" (substring old-content start end)) @@ -3097,6 +3144,8 @@ (cond ((not path) (error 'replace_range "missing path arg")) ((not content) (replace-range-missing-content-message cwd args)) + ((placeholder-only-content? content) + (guard-placeholder-content! 'replace_range path content)) ((<= start-line 0) (error 'replace_range "missing positive start arg")) ((< end-line start-line) (error 'replace_range "end must be >= start")) ((rejected-draft-hard-recovery-message cwd 'replace_range) => (lambda (msg) msg)) @@ -3104,7 +3153,7 @@ (else (let ((p (abs-path cwd path))) (unless (file-exists? p) - (error 'replace_range "target does not exist: ~a" path)) + (error 'replace_range (format "target does not exist: ~a" path))) (let* ((old-content (read-file-string p)) (repair (current-required-range-repair)) (covers-repair? @@ -3124,8 +3173,8 @@ old-content start-line end-line replacement-content))) (unless new-content (error 'replace_range - "line range ~a-~a not found in ~a" - start-line end-line path)) + (format "line range ~a-~a not found in ~a" + start-line end-line path))) (guard-jerboa-syntax-for-replace-range! cwd path start-line end-line new-content replacement-content) (write-file-string p new-content) @@ -3153,10 +3202,14 @@ ((not path) (error 'edit "missing path arg")) ((and (not content) (not old-str)) (error 'edit "missing content arg or old_str/new_str args")) + ((placeholder-only-content? (or new-str content)) + (guard-placeholder-content! 'edit path (or new-str content))) ((write-scope-error "edit" (scope-path cwd path)) => (lambda (msg) (error 'edit msg))) ((path-has-symlink-component? cwd path) - (error 'edit "refusing write through symlink path component: ~a" path)) + (error 'edit + (format "refusing write through symlink path component: ~a" + path))) ((and (current-required-range-repair) (not required-full-rewrite?)) (required-repair-message 'edit (current-required-range-repair))) @@ -3227,7 +3280,7 @@ " after appending minimal delimiter suffix" ""))))))) ((not (file-exists? p)) - (error 'edit "replace target does not exist: ~a" path)) + (error 'edit (format "replace target does not exist: ~a" path))) (else (let* ((old-content (read-file-string p)) (new-content (replace-first old-content old-str (or new-str "")))) @@ -3405,12 +3458,13 @@ "missing path arg; use {\"path\":\"main.ss\",\"kind\":\"minimal-pass\"}")) ((not (source-ss-path? path)) (error 'create_verified_jerboa_script - "path must end in .ss for a Jerboa script: ~a" path)) + (format "path must end in .ss for a Jerboa script: ~a" path))) ((write-scope-error "create_verified_jerboa_script" (scope-path cwd path)) => (lambda (msg) (error 'create_verified_jerboa_script msg))) ((path-has-symlink-component? cwd path) (error 'create_verified_jerboa_script - "refusing write through symlink path component: ~a" path)) + (format "refusing write through symlink path component: ~a" + path))) (else (let* ((created-new? (not (file-exists? (abs-path cwd path)))) (result