Narrow mutation schemas to single write scope

ober

51b0f13c2fffea2ebfbe2d1d8f4026368e77c7a7

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 3ab3421..3890bbf 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -111,6 +111,12 @@
                   (string-suffix? ".md" path))
               path))))
 
+(def (scope-single-path scope)
+  (and (list? scope)
+       (= (length scope) 1)
+       (let ((path (car scope)))
+         (and (string? path) path))))
+
 (def (jerboa-project-cwd? cwd)
   (or (file-exists? (string-append cwd "/jerboa.pkg"))
       (file-exists? (string-append cwd "/mcp/server.ss"))
@@ -5176,6 +5182,17 @@
     (list (cons "type" "string")
           (cons "description" desc))))
 
+(def (mutation-path-schema desc)
+  (let ((target (scope-single-path (current-write-scope))))
+    (if target
+      (schema-object
+        (list (cons "type" "string")
+              (cons "enum" (list target))
+              (cons "description"
+                    (string-append desc ". Only valid write-scope path: "
+                                   target))))
+      (string-schema desc))))
+
 (def (number-schema desc)
   (schema-object
     (list (cons "type" "number")
@@ -5252,6 +5269,20 @@
                         (cons "line" (number-schema "1-based line number for line replacement")))))
           (cons "required" (list "path")))))
 
+(def (scoped-edit-schema)
+  (schema-object
+    (list (cons "type" "object")
+          (cons "properties"
+                (schema-object
+                  (list (cons "path" (mutation-path-schema "File path to edit"))
+                        (cons "file" (mutation-path-schema "Alias for path"))
+                        (cons "content" (string-schema "Complete new file contents, or replacement text with old_str"))
+                        (cons "contents" (string-schema "Alias for content"))
+                        (cons "old_str" (string-schema "Exact existing text to replace"))
+                        (cons "new_str" (string-schema "Replacement text"))
+                        (cons "line" (number-schema "1-based line number for line replacement")))))
+          (cons "required" (list "path")))))
+
 (def *exact-edit-schema*
   (schema-object
     (list (cons "type" "object")
@@ -5273,6 +5304,17 @@
                         (cons "contents" (string-schema "Alias for content")))))
           (cons "required" (list "path" "content")))))
 
+(def (scoped-write-schema)
+  (schema-object
+    (list (cons "type" "object")
+          (cons "properties"
+                (schema-object
+                  (list (cons "path" (mutation-path-schema "File path to write"))
+                        (cons "file" (mutation-path-schema "Alias for path"))
+                        (cons "content" (string-schema "Complete file contents"))
+                        (cons "contents" (string-schema "Alias for content")))))
+          (cons "required" (list "path" "content")))))
+
 (def *line-edit-schema*
   (schema-object
     (list (cons "type" "object")
@@ -5284,6 +5326,17 @@
                         (cons "content" (string-schema "Replacement line content")))))
           (cons "required" (list "path" "line" "content")))))
 
+(def (scoped-line-edit-schema)
+  (schema-object
+    (list (cons "type" "object")
+          (cons "properties"
+                (schema-object
+                  (list (cons "path" (mutation-path-schema "File path to edit"))
+                        (cons "file" (mutation-path-schema "Alias for path"))
+                        (cons "line" (number-schema "1-based line number"))
+                        (cons "content" (string-schema "Replacement line content")))))
+          (cons "required" (list "path" "line" "content")))))
+
 (def *replace-def-schema*
   (schema-object
     (list (cons "type" "object")
@@ -5294,6 +5347,16 @@
                         (cons "content" (string-schema "Complete replacement definition")))))
           (cons "required" (list "path" "name" "content")))))
 
+(def (scoped-replace-def-schema)
+  (schema-object
+    (list (cons "type" "object")
+          (cons "properties"
+                (schema-object
+                  (list (cons "path" (mutation-path-schema "File path to edit"))
+                        (cons "name" (string-schema "Top-level function name"))
+                        (cons "content" (string-schema "Complete replacement definition")))))
+          (cons "required" (list "path" "name" "content")))))
+
 (def *replace-range-schema*
   (schema-object
     (list (cons "type" "object")
@@ -5306,6 +5369,18 @@
                         (cons "new_str" (string-schema "Alias for content")))))
           (cons "required" (list "path" "start" "end" "content")))))
 
+(def (scoped-replace-range-schema)
+  (schema-object
+    (list (cons "type" "object")
+          (cons "properties"
+                (schema-object
+                  (list (cons "path" (mutation-path-schema "File path to edit"))
+                        (cons "start" (number-schema "1-based inclusive start line"))
+                        (cons "end" (number-schema "1-based inclusive end line"))
+                        (cons "content" (string-schema "Replacement content for the range"))
+                        (cons "new_str" (string-schema "Alias for content")))))
+          (cons "required" (list "path" "start" "end" "content")))))
+
 (def *done-schema*
   (schema-object
     (list (cons "type" "object")
@@ -5616,19 +5691,22 @@
           (make-tool-def
             (make-tool-spec "edit"
               "Edit a file. Full write args: {\"path\": string, \"content\": string}; \"file\", \"filename\", \"file_path\", \"filepath\", \"target\", and \"target_path\" are accepted as path aliases. \"file\" is still accepted as a content alias when a separate path is present. \"contents\", \"new_content\", \"body\", and \"text\" are accepted as content aliases. Exact replacement args: {\"path\": string, \"old_str\": string, \"new_str\": string}; old_string/new_string are accepted aliases; \"content\" may be used instead of \"new_str\" when \"old_str\" is present. Line replacement args: {\"path\": string, \"line\": number, \"content\": string}."
-              *edit-schema*)
+              (parameterize ((current-write-scope scope))
+                (scoped-edit-schema)))
             (scoped-tool (lambda (args) (do-edit args cwd))) '()))
         (write-def
           (make-tool-def
             (make-tool-spec "write"
               "Alias for edit. Full write args: {\"path\": string, \"content\": string}. Exact replacement accepts old_str/new_str or old_string/new_string. \"file\" is accepted as a path alias and content/file/body/text aliases are accepted like edit."
-              *write-schema*)
+              (parameterize ((current-write-scope scope))
+                (scoped-write-schema)))
             (scoped-tool (lambda (args) (do-edit args cwd))) '()))
         (line-edit-def
           (make-tool-def
             (make-tool-spec "line_edit"
               "Replace exactly one line in a file. args: {\"path\": string, \"line\": number, \"content\": string}. \"file\" is accepted as a path alias. Use this for compiler errors or verifier diagnostics with stable line numbers."
-              *line-edit-schema*)
+              (parameterize ((current-write-scope scope))
+                (scoped-line-edit-schema)))
             (scoped-tool (lambda (args)
               (let ((path (arg-path args #f))
                     (content (arg-content args))
@@ -5655,14 +5733,16 @@
           (make-tool-def
             (make-tool-spec "replace_def"
               "Replace a whole top-level function definition by name using delimiter matching. args: {\"path\": string, \"name\": string, \"content\": string}. Use this when a verifier error is inside one function and exact old_str replacement is brittle."
-              *replace-def-schema*)
+              (parameterize ((current-write-scope scope))
+                (scoped-replace-def-schema)))
             (scoped-tool (lambda (args) (replace-definition args cwd)))
             '()))
         (replace-range-def
           (make-tool-def
             (make-tool-spec "replace_range"
               "Replace an inclusive line range, even if the old code is unbalanced. args: {\"path\": string, \"start\": number, \"end\": number, \"content\": string}. Replacement aliases accepted: new_content, new_str, new_string, replacement, body, text. Path/start/end without content is rejected without changing the file. Use this after balance/read/sed identifies a broken span and replace_def cannot parse it."
-              *replace-range-schema*)
+              (parameterize ((current-write-scope scope))
+                (scoped-replace-range-schema)))
             (scoped-tool (lambda (args) (replace-range args cwd)))
             '()))
         (verify-def
diff --git a/test/run.ss b/test/run.ss
index b2a54d3..ad4842a 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -4350,6 +4350,15 @@
   (let* ([scope (parse-write-scope allowed)]
          [wf   (coding-workflow (string-append "grep -q scoped " allowed) vr-dir
                                 (list (cons 'write-scope scope)))]
+         [path-enum
+           (lambda (tool-name)
+             (let* ([schema (tool-spec-parameters
+                              (tool-def-spec
+                                (workflow-get-tool-def wf tool-name)))]
+                    [props (hashtable-ref schema "properties" #f)]
+                    [path-schema (and props
+                                      (hashtable-ref props "path" #f))])
+               (and path-schema (hashtable-ref path-schema "enum" #f))))]
          [resp (scripted-responder
                  (list
                    (list (make-wtool-call "edit" (list (cons "path" denied) (cons "content" "bad")) #f))
@@ -4359,6 +4368,12 @@
          [result (parameterize ((current-write-scope scope))
                    (run-workflow wf "write within scope" resp
                                  (list (cons 'max-iterations 8))))])
+    (check! "verified-run: scoped edit schema narrows path enum"
+            (path-enum "edit") (list allowed))
+    (check! "verified-run: scoped write schema narrows path enum"
+            (path-enum "write") (list allowed))
+    (check! "verified-run: scoped line_edit schema narrows path enum"
+            (path-enum "line_edit") (list allowed))
     (check! "verified-run: scoped edit can still complete after refused out-of-scope edit"
             result "scope-ok")
     (check! "verified-run: out-of-scope edit did not create file"