Improve error handling for native tools

Author: ericdallo

src/eca/features/tools/filesystem.clj

@@ -11,20 +11,27 @@
                :content text
                :error (boolean error)}]})
 
-(defn ^:private not-allowed-path [path db]
-  (when (not-any? #(fs/starts-with? path (shared/uri->filename (:uri %)))
-                  (:workspace-folders db))
-    (single-text-content "Access denied - path outside workspace root, call list_allowed_dirs first")))
+(defn ^:private allowed-path? [db path]
+  (some #(fs/starts-with? path (shared/uri->filename (:uri %)))
+        (:workspace-folders db)))
 
 (defn ^:private list-allowed-directories [_arguments db]
   (single-text-content
    (str "Allowed directories:\n"
         (string/join "\n"
                      (map (comp shared/uri->filename :uri) (:workspace-folders db))))))
 
+(defn ^:private invalid-arguments [arguments validator]
+  (first (keep (fn [[key pred error-msg]]
+                 (let [value (get arguments key)]
+                   (when-not (pred value)
+                     (single-text-content (string/replace error-msg (str "$" key) value)))))
+               validator)))
+
 (defn ^:private list-directory [arguments db]
-  (let [path (fs/canonicalize (get arguments "path"))]
-    (or (not-allowed-path path db)
+  (let [path (delay (fs/canonicalize (get arguments "path")))]
+    (or (invalid-arguments arguments [["path" fs/regular-file? "$path is not a valid path"]
+                                      ["path" (partial allowed-path? db) "Access denied - path $path outside allowed directories"]])
         (single-text-content
          (reduce
           (fn [out path]
@@ -33,7 +40,7 @@
                          (if (fs/directory? path) "DIR" "FILE")
                          path)))
           ""
-          (fs/list-dir path))))))
+          (fs/list-dir @path))))))
 
 (def definitions
   {"list_allowed_directories"

test/eca/features/tools/filesystem_test.clj

@@ -1,7 +1,6 @@
 (ns eca.features.tools.filesystem-test
   (:require
    [babashka.fs :as fs]
-   [clojure.string :as string]
    [clojure.test :refer [deftest is testing]]
    [eca.features.tools.filesystem :as f.tools.filesystem]
    [eca.test-helper :as h]
@@ -18,12 +17,23 @@
         {:workspace-folders [{:uri (h/file-uri "file:///foo/bar/baz") :name "baz"}]}))))
 
 (deftest list-directory-test
-  (testing "unallowed dir"
+  (testing "Invalid path"
     (is (match?
          {:contents [{:type :text
                       :error false
-                      :content "Access denied - path outside workspace root, call list_allowed_dirs first"}]}
-         (with-redefs [fs/canonicalize (constantly (h/file-path "/foo/qux"))]
+                      :content "/foo/qux is not a valid path"}]}
+         (with-redefs [fs/canonicalize (constantly (h/file-path "/foo/qux"))
+                       fs/regular-file? (constantly false)]
+           ((get-in f.tools.filesystem/definitions ["list_directory" :handler])
+            {"path" (h/file-path "/foo/qux")}
+            {:workspace-folders [{:uri (h/file-uri "file:///foo/bar/baz") :name "baz"}]})))))
+  (testing "Unallowed dir"
+    (is (match?
+         {:contents [{:type :text
+                      :error false
+                      :content "Access denied - path /foo/qux outside allowed directories"}]}
+         (with-redefs [fs/canonicalize (constantly (h/file-path "/foo/qux"))
+                       fs/regular-file? (constantly true)]
            ((get-in f.tools.filesystem/definitions ["list_directory" :handler])
             {"path" (h/file-path "/foo/qux")}
             {:workspace-folders [{:uri (h/file-uri "file:///foo/bar/baz") :name "baz"}]})))))
@@ -35,7 +45,8 @@
                                             "[DIR] %s\n")
                                        (h/file-path "/foo/bar/baz/some.clj")
                                        (h/file-path "/foo/bar/baz/qux"))}]}
-         (with-redefs [fs/starts-with? (constantly true)
+         (with-redefs [fs/regular-file? (constantly true)
+                       fs/starts-with? (constantly true)
                        fs/list-dir (constantly [(fs/path (h/file-path "/foo/bar/baz/some.clj"))
                                                 (fs/path (h/file-path "/foo/bar/baz/qux"))])
                        fs/directory? (fn [path] (not (string/ends-with? (str path) ".clj")))