Added ability to cancel tool calls.

CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## Unreleased
 
+- Added ability to cancel tool calls. Only the shell tool
+  currently. #145
+
 ## 0.64.1
 
 - Fix duplicated arguments on `toolCallPrepare` for openai-chat API models. https://github.com/editor-code-assistant/eca-emacs/issues/56

src/eca/features/tools.clj

@@ -246,6 +246,11 @@
   [name arguments details result]
   (tools.util/tool-call-details-after-invocation name arguments details result))
 
+(defn tool-call-destroy-resource!
+  "Destroy the resource in the tool call named `name`."
+  [name resource-kwd resource]
+  (tools.util/tool-call-destroy-resource! name resource-kwd resource))
+
 (defn refresh-tool-servers!
   "Updates all tool servers (native and MCP) with new behavior status."
   [tool-status-fn db* messenger config]

src/eca/features/tools/shell.clj

@@ -15,7 +15,7 @@
 (def ^:private default-timeout 60000)
 (def ^:private max-timeout (* 60000 10))
 
-(defn ^:private shell-command [arguments {:keys [db]}]
+(defn ^:private shell-command [arguments {:keys [db tool-call-id call-state-fn state-transition-fn]}]
   (let [command-args (get arguments "command")
         user-work-dir (get arguments "working_directory")
         timeout (min (or (get arguments "timeout") default-timeout) max-timeout)]
@@ -29,15 +29,37 @@
                            (config/get-property "user.home"))
               _ (logger/debug logger-tag "Running command:" command-args)
               result (try
-                       (deref (p/process {:dir work-dir
-                                          :out :string
-                                          :err :string
-                                          :timeout timeout
-                                          :continue true} "bash -c" command-args)
-                              timeout
-                              ::timeout)
+                       (if-let [proc (when-not (= :stopping (:status (call-state-fn)))
+                                       (p/process {:dir work-dir
+                                                   :out :string
+                                                   :err :string
+                                                   :timeout timeout
+                                                   :continue true} "bash -c" command-args))]
+                         (do
+                           (state-transition-fn :resources-created {:resources {:process proc}})
+                           (try (deref proc
+                                       timeout
+                                       ::timeout)
+                                (catch InterruptedException e
+                                  (let [msg (or (.getMessage e) "Shell tool call was interrupted")]
+                                    (logger/debug logger-tag "Shell tool call was interrupted" {:tool-call-id tool-call-id :message msg})
+                                    (tools.util/tool-call-destroy-resource! "eca_shell_command" :process proc)
+                                    (state-transition-fn :resources-destroyed {:resources [:process]})
+                                    {:exit 1 :err msg}))))
+                         {:exit 1 :err "Tool call is :stopping, so shell rpocess not spawned"})
                        (catch Exception e
-                         {:exit 1 :err (.getMessage e)}))
+                         ;; Process did not start, or had an Exception (other than InterruptedException) during execution.
+                         (let [msg (or (.getMessage e) "Caught an Exception during execution of the shell tool")]
+                           (logger/warn logger-tag "Got an Exception during execution" {:message msg})
+                           {:exit 1 :err msg}))
+                       (finally
+                         ;; If any resources remain, destroy them.
+                         (let [state (call-state-fn)]
+                           (when-let [resources (:resources state)]
+                             (doseq [[res-kwd res] resources]
+                               (tools.util/tool-call-destroy-resource! "eca_shell_command" res-kwd res))
+                             (when (#{:executing :stopping} (:status state))
+                               (state-transition-fn :resources-destroyed {:resources (keys resources)}))))))
               err (some-> (:err result) string/trim)
               out (some-> (:out result) string/trim)]
           (cond
@@ -90,3 +112,10 @@
                                (let [workspace-roots (mapv (comp shared/uri->filename :uri) (:workspace-folders db))]
                                  (not-any? #(fs/starts-with? wd %) workspace-roots)))))
     :summary-fn #'shell-command-summary}})
+
+(defmethod tools.util/tool-call-destroy-resource! :eca_shell_command [name resource-kwd resource]
+  (logger/debug logger-tag "About to destroy resource" {:resource-kwd resource-kwd})
+  (case resource-kwd
+    :process (p/destroy-tree resource)
+    (logger/warn logger-tag "Unknown resource keyword" {:tool-name name
+                                                        :resource-kwd resource-kwd})))

src/eca/features/tools/util.clj

@@ -19,6 +19,14 @@
 (defmethod tool-call-details-after-invocation :default [_name _arguments details _result]
   details)
 
+(defmulti tool-call-destroy-resource!
+  "Destroy the tool call resource."
+  (fn [name _resource-kwd _resource] (keyword name)))
+
+(defmethod tool-call-destroy-resource! :default [_name _resource-kwd _resource]
+  ;; By default, do nothing
+  )
+
 (defn single-text-content [text & [error]]
   {:error (boolean error)
    :contents [{:type :text

test/eca/features/chat_tool_call_state_test.clj

@@ -100,10 +100,12 @@
           "Expected state machine to contain [:execution-approved :stop-requested] transition")
       (is (contains? state-machine [:executing :stop-requested])
           "Expected state machine to contain [:executing :stop-requested] transition")
+      (is (contains? state-machine [:stopping :stop-requested])
+          "Expected state machine to contain [:stopping :stop-requested] transition")
+      (is (contains? state-machine [:cleanup :stop-requested])
+          "Expected state machine to contain [:cleanup :stop-requested] transition")
 
-      ;; Note: :rejected, :completed and :stopped are terminal states, so no stop transitions.
-      (is (not (contains? state-machine [:stopped :stop-requested]))
-          "Expected :rejected state to not have stop transition defined, since it is a terminal state")
+      ;; Note: :rejected and :completed are terminal states, so no stop transitions.
       (is (not (contains? state-machine [:rejected :stop-requested]))
           "Expected :rejected state to not have stop transition defined, since it is a terminal state")
       (is (not (contains? state-machine [:completed :stop-requested]))
@@ -261,7 +263,7 @@
       (let [result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :tool-run run-event-data)]
 
         (is (match? {:status :check-approval
-                     :actions [:init-arguments :init-approval-promise :send-toolCallRun]}
+                     :actions [:init-arguments :init-approval-promise :init-future-cleanup-promise :send-toolCallRun]}
                     result)
             "Expected next state to be :check-approval with actions of :init-approval-promise and :send-toolCallRun")
 
@@ -316,7 +318,7 @@
       ;; Step 2: :preparing -> :check-approval
       (let [result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :tool-run run-event-data)]
         (is (match? {:status :check-approval
-                     :actions [:init-arguments :init-approval-promise :send-toolCallRun]}
+                     :actions [:init-arguments :init-approval-promise :init-future-cleanup-promise :send-toolCallRun]}
                     result)
             "Expected transition to :check-approval with init promise and send run actions")
 
@@ -451,31 +453,31 @@
         (let [result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-start
                                                      {:name "list_files" :origin "filesystem" :arguments {:path "/tmp"}})]
           (is (match? {:status :executing
-                       :actions [:set-start-time :set-call-future :send-toolCallRunning :send-progress]}
+                       :actions [:set-start-time :add-future :send-toolCallRunning :send-progress]}
                       result)
               "Expected transition to :executing status with no additional actions")
 
           (let [tool-state (#'f.chat/get-tool-call-state @db* chat-id tool-call-id)]
             (is (= :executing (:status tool-state))
                 "Expected tool call state to be in :executing status"))))
 
-      ;; Step 2: :executing -> :completed
-      (testing ":executing -> :completed transition"
+      ;; Step 2: :executing -> :cleanup
+      (testing ":executing -> :cleanup transition"
         (let [result-data {:outputs "file1.txt\nfile2.txt\nfile3.txt"
                            :error nil
                            :name "list_files"
                            :origin "filesystem"
                            :arguments {:path "/tmp"}}
               result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-end result-data)]
 
-          (is (match? {:status :completed
-                       :actions [:send-toolCalled :log-metrics :send-progress]}
+          (is (match? {:status :cleanup
+                       :actions [:deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]}
                       result)
-              "Expected transition to :completed with send toolCalled and record metrics actions")
+              "Expected transition to :cleanup with send toolCalled and record metrics actions")
 
           (let [tool-state (#'f.chat/get-tool-call-state @db* chat-id tool-call-id)]
-            (is (= :completed (:status tool-state))
-                "Expected tool call state to be in :completed status"))
+            (is (= :cleanup (:status tool-state))
+                "Expected tool call state to be in :cleanup status"))
 
           (let [messages (h/messages)
                 chat-messages (:chat-content-received messages)
@@ -501,15 +503,15 @@
           chat-id "test-chat"
           chat-ctx {:chat-id chat-id :request-id "req-1" :messenger (h/messenger)}]
 
-      ;; Test :initial -> :stopped
-      (testing ":initial -> :stopped"
+      ;; Test :initial -> :cleanup
+      (testing ":initial -> :cleanup"
         (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-initial" :stop-requested)]
-          (is (match? {:status :stopped :actions []} result)
-              "Expected transition from :initial to :stopped with no actions")))
+          (is (match? {:status :cleanup :actions []} result)
+              "Expected transition from :initial to :cleanup with no actions")))
 
-      ;; Test :preparing -> :stopped (already covered in transition-tool-call-stop-transitions-test)
-      ;; Test :check-approval -> :stopped
-      (testing ":check-approval -> :stopped"
+      ;; Test :preparing -> :cleanup (already covered in transition-tool-call-stop-transitions-test)
+      ;; Test :check-approval -> :cleanup
+      (testing ":check-approval -> :cleanup"
         (let [approved?* (promise)]
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-check" :tool-prepare
                                           {:name "test" :origin "test" :arguments-text "{}"})
@@ -522,8 +524,8 @@
                         result)
                 "Expected transition from :check-approval to :rejected with relevant actions"))))
 
-      ;; Test :executing -> :stopping -> :stopped
-      (testing ":executing -> :stopping -> :stopped"
+      ;; Test :executing -> :stopping -> :cleanup
+      (testing ":executing -> :stopping -> :cleanup"
         (let [approved?* (promise)]
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-executing" :tool-prepare
                                           {:name "test" :origin "test" :arguments-text "{}"})
@@ -535,18 +537,18 @@
 
           (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-executing" :stop-requested)]
             (is (match? {:status :stopping
-                         :actions []}
+                         :actions [:cancel-future]}
                         result)
                 "Expected transition from :executing to :stopping with relevant actions"))
           (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-executing" :stop-attempted)]
-            (is (match? {:status :stopped
-                         :actions [:send-toolCallRejected]}
+            (is (match? {:status :cleanup
+                         :actions [:deliver-future-cleanup-completed :send-toolCallRejected]}
                         result)
-                "Expected transition from :stopping to :stopped with relevant actions"))))
+                "Expected transition from :stopping to :cleanup with relevant actions"))))
 
 
-      ;; Test :completed -> :stopped (should be no-op or error)
-      (testing ":completed -> :stopped (should handle gracefully)"
+      ;; Test :cleanup -> :cleanup (should be no-op or error)
+      (testing ":cleanup -> :cleanup (should handle gracefully)"
         (let [approved?* (promise)]
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-completed" :tool-prepare
                                           {:name "test" :origin "test" :arguments-text "{}"})
@@ -558,15 +560,15 @@
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-completed" :execution-end
                                           {:outputs "success" :error nil :name "test" :origin "test" :arguments {}})
 
-          ;; Now try to stop a completed tool call
-          (is (thrown-with-msg?
-               clojure.lang.ExceptionInfo
-               #"Invalid state transition"
-               (#'f.chat/transition-tool-call! db* chat-ctx "tool-completed" :stop-requested))
-              "Expected exception as completed tool calls cannot be stopped")))
+          ;; Now try to stop a tool call in :cleanup
+          (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-completed" :stop-requested)]
+            (is (match? {:status :cleanup
+                         :actions []}
+                        result)
+                "Expected a transition from :cleanup on :stop-requested to be a nop"))))
 
-      ;; Test :rejected -> :stopped
-      (testing ":rejected -> :stopped (should handle gracefully)"
+      ;; Test :rejected -> :cleanup
+      (testing ":rejected -> :cleanup (should handle gracefully)"
         (let [approved?* (promise)]
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-rejected" :tool-prepare
                                           {:name "test" :origin "test" :arguments-text "{}"})
@@ -591,17 +593,17 @@
           chat-id "test-chat"
           chat-ctx {:chat-id chat-id :request-id "req-1" :messenger (h/messenger)}]
 
-      (testing ":preparing -> :stopped"
+      (testing ":preparing -> :cleanup"
         (#'f.chat/transition-tool-call! db* chat-ctx "tool-1" :tool-prepare
                                         {:name "test" :origin "test" :arguments-text "{}"})
 
         (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-1" :stop-requested)]
-          (is (match? {:status :stopped
+          (is (match? {:status :cleanup
                        :actions [:set-decision-reason :send-toolCallRejected]}
                       result)
-              "Expected transition to :stopped with send toolCallRejected action")
-          (is (= :stopped (:status (#'f.chat/get-tool-call-state @db* chat-id "tool-1")))
-              "Expected tool call state to be in :stopped status")))
+              "Expected transition to :cleanup with send toolCallRejected action")
+          (is (= :cleanup (:status (#'f.chat/get-tool-call-state @db* chat-id "tool-1")))
+              "Expected tool call state to be in :cleanup status")))
 
       (testing ":waiting-approval -> :rejected"
         (let [approved?* (promise)]
@@ -622,7 +624,7 @@
             (is (= false (deref approved?* 100 :timeout))
                 "Expected promise to be delivered with false value"))))
 
-      (testing ":execution-approved -> :stopped"
+      (testing ":execution-approved -> :cleanup"
         (let [approved?* (promise)]
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-3" :tool-prepare
                                           {:name "test" :origin "test" :arguments-text "{}"})
@@ -631,12 +633,12 @@
           (#'f.chat/transition-tool-call! db* chat-ctx "tool-3" :approval-allow)
 
           (let [result (#'f.chat/transition-tool-call! db* chat-ctx "tool-3" :stop-requested)]
-            (is (match? {:status :stopped
+            (is (match? {:status :cleanup
                          :actions [:send-toolCallRejected]}
                         result)
-                "Expected transition to :stopped with send toolCallRejected action")
-            (is (= :stopped (:status (#'f.chat/get-tool-call-state @db* chat-id "tool-3")))
-                "Expected tool call state to be in :stopped status")))))))
+                "Expected transition to :cleanup with send toolCallRejected action")
+            (is (= :cleanup (:status (#'f.chat/get-tool-call-state @db* chat-id "tool-3")))
+                "Expected tool call state to be in :cleanup status")))))))
 
 (deftest test-stop-prompt-messages
   ;; Test what messages are sent when stop-prompt is called
@@ -829,7 +831,7 @@
 
 (deftest transition-tool-call-stop-during-execution-test
   ;; Test stopping a tool call during execution 
-  (testing ":executing -> :stopping -> :stopped transition"
+  (testing ":executing -> :stopping -> :cleanup transition"
     (h/reset-components!)
     (let [db* (h/db*)
           chat-id "test-chat"
@@ -858,8 +860,8 @@
             result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :stop-attempted)]
         (is (= :stopping (:status tool-state))
             "Expected tool call state to be in :stopping status")
-        (is (= :stopped (:status result))
-            "Expected tool call state to be :stopped after :stop-requested"))
+        (is (= :cleanup (:status result))
+            "Expected tool call state to be :cleanup after :stop-requested"))
       )))
 
 (deftest transition-tool-call-nonexistent-tool-call-operations-test
@@ -896,7 +898,7 @@
       (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-start
                                       {:name "test" :server "eca" :origin "test" :arguments {}})
 
-      (testing ":executing -> :completed with error"
+      (testing ":executing -> :cleanup with error"
         (let [error-result {:outputs nil
                             :error "File not found: /nonexistent/path"
                             :name "test"
@@ -905,10 +907,10 @@
                             :arguments {}}
               result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-end error-result)]
 
-          (is (match? {:status :completed
-                       :actions [:send-toolCalled :log-metrics :send-progress]}
+          (is (match? {:status :cleanup
+                       :actions [:deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]}
                       result)
-              "Expected transition to :completed with send toolCalled and record metrics actions")
+              "Expected transition to :cleanup with send toolCalled and record metrics actions")
 
           (let [messages (h/messages)
                 chat-messages (:chat-content-received messages)