diff --git a/CHANGELOG.md b/CHANGELOG.md index 97dd9ef0..e08d042f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ # Changelog ## Unreleased +- Enhanced hooks documentation with new types (sessionStart, sessionEnd, chatStart, chatEnd), JSON input/output schemas, execution options (timeout) - Fix custom tools to support argument numbers. - Improve read_file summary to mention offset being read. diff --git a/docs/configuration.md b/docs/configuration.md index 9158ff0d..786e3197 100644 --- a/docs/configuration.md +++ b/docs/configuration.md @@ -349,29 +349,66 @@ ECA allows to totally customize the prompt sent to LLM via the `behavior` config } } ``` - + ## Hooks -Hooks are actions that can run before or after an specific event, useful to notify after prompt finished or to block a tool call doing some check in a script. +Hooks are shell actions that run before or after specific events, useful for notifications, injecting context, modifying inputs, or blocking tool calls. + +### Hook Types + +| Type | When | Can Modify | +|------|------|------------| +| `sessionStart` | Server initialized | - | +| `sessionEnd` | Server shutting down | - | +| `chatStart` | New chat or resumed chat | Can inject `additionalContext` | +| `chatEnd` | Chat deleted | - | +| `preRequest` | Before prompt sent to LLM | Can rewrite prompt, inject context, stop request | +| `postRequest` | After prompt finished | - | +| `preToolCall` | Before tool execution | Can modify args, override approval, reject | +| `postToolCall` | After tool execution | Can inject context for next LLM turn | + +### Hook Options -Allowed hook types: +- **`matcher`**: Regex for `server__tool-name`, only for `*ToolCall` hooks. +- **`visible`**: Show hook execution in chat (default: `true`). +- **`runOnError`**: For `postToolCall`, run even if tool errored (default: `false`). -- `preRequest`: Run before prompt is sent to LLM, if a hook output is provided, append to user prompt. -- `postRequest`: Run after prompt is finished, when chat come back to idle state. -- `preToolCall`: Run before a tool is called, if a hook exit with status `2`, reject the tool call. -- `postToolCall`: Run after a tool was called. +### Execution Details -__Input__: Hooks will receive input as json with information from that event, like tool name, args or user prompt. +- **Order**: Alphabetical by key. Prompt rewrites chain; argument updates merge (last wins). +- **Conflict**: Any rejection (`deny` or exit `2`) blocks the call immediately. +- **Timeout**: Actions time out after 30s unless `"timeout": ms` is set. -__Output__: All hook actions allow printing output (stdout) and errors (stderr) which will be shown in chat. +### Input / Output -__Matcher__: Specify whether to apply this hook checking a regex applying to `mcp__tool-name`, applicable only for `*ToolCall` hooks. +Hooks receive JSON via stdin with event data (top-level keys `snake_case`, nested data preserves case). Common fields: -__Visible__: whether to show or not this hook in chat when executing, defaults to true. +- All hooks: `hook_name`, `hook_type`, `workspaces`, `db_cache_path` +- Chat hooks add: `chat_id`, `behavior` +- Tool hooks add: `tool_name`, `server`, `tool_input`, `approval` (pre) or `tool_response`, `error` (post) +- `chatStart` adds: `resumed` (boolean) -Examples: +Hooks can output JSON to control behavior: + +```javascript +{ + "additionalContext": "Extra context for LLM", // injected as XML block + "replacedPrompt": "New prompt text", // preRequest only + "updatedInput": {"key": "value"}, // preToolCall: merge into tool args + "approval": "allow" | "ask" | "deny", // preToolCall: override approval + "continue": false, // stop processing (with optional stopReason) + "stopReason": "Why stopped", + "suppressOutput": true // hide hook output from chat +} +``` -=== "Notify after prompt finish" +Plain text output (non-JSON) is treated as `additionalContext`. + +To reject a tool call, either output `{"approval": "deny"}` or exit with code `2`. + +### Examples + +=== "Notify after prompt" ```javascript title="~/.config/eca/config.json" { @@ -379,21 +416,16 @@ Examples: "notify-me": { "type": "postRequest", "visible": false, - "actions": [ - { - "type": "shell", - "shell": "notify-send \"Hey, prompt finished!\"" - } - ] + "actions": [{"type": "shell", "shell": "notify-send 'Prompt finished!'"}] } } - } + } ``` - + === "Ring bell sound when pending tool call approval" ```javascript title="~/.config/eca/hooks/my-hook.sh" - [[ $(jq '.approval == "ask"' <<< "$1") ]] && canberra-gtk-play -i complete + jq -e '.approval == "ask"' > /dev/null && canberra-gtk-play -i complete ``` ```javascript title="~/.config/eca/config.json" @@ -405,7 +437,7 @@ Examples: "actions": [ { "type": "shell", - "shell": "${file:hooks/my-hook.sh}" + "file": "hooks/my-hook.sh" } ] } @@ -413,26 +445,85 @@ Examples: } ``` +=== "Inject context on chat start" + + ```javascript title="~/.config/eca/config.json" + { + "hooks": { + "load-context": { + "type": "chatStart", + "actions": [{ + "type": "shell", + "shell": "echo '{\"additionalContext\": \"Today is '$(date +%Y-%m-%d)'\"}'" + }] + } + } + } + ``` -=== "Block specific tool call checking hook arg" +=== "Rewrite prompt" ```javascript title="~/.config/eca/config.json" { "hooks": { - "check-my-tool": { - "type": "preToolCall", - "matcher": "my-mcp__some-tool", - "actions": [ - { - "type": "shell", - "shell": "tool=$(jq '.\"tool-name\"' <<< \"$1\"); echo \"We should not run the $tool tool bro!\" >&2 && exit 2" - } - ] + "add-prefix": { + "type": "preRequest", + "actions": [{ + "type": "shell", + "shell": "jq -c '{replacedPrompt: (\"[IMPORTANT] \" + .prompt)}'" + }] } } } ``` - + +=== "Block tool with JSON response" + + ```javascript title="~/.config/eca/config.json" + { + "hooks": { + "block-rm": { + "type": "preToolCall", + "matcher": "eca__shell_command", + "actions": [{ + "type": "shell", + "shell": "if jq -e '.tool_input.command | test(\"rm -rf\")' > /dev/null; then echo '{\"approval\":\"deny\",\"additionalContext\":\"Dangerous command blocked\"}'; fi" + }] + } + } + } + ``` + +=== "Modify tool arguments" + + ```javascript title="~/.config/eca/config.json" + { + "hooks": { + "force-recursive": { + "type": "preToolCall", + "matcher": "eca__directory_tree", + "actions": [{ + "type": "shell", + "shell": "echo '{\"updatedInput\": {\"max_depth\": 3}}'" + }] + } + } + } + ``` + +=== "Use external script file" + + ```javascript title="~/.config/eca/config.json" + { + "hooks": { + "my-hook": { + "type": "preToolCall", + "actions": [{"type": "shell", "file": "~/.config/eca/hooks/check-tool.sh"}] + } + } + } + ``` + ## Completion You can configure which model and system prompt ECA will use during its inline completion: @@ -498,12 +589,16 @@ To configure, add your OTLP collector config via `:otlp` map following [otlp aut }}; defaultModel?: string; hooks?: {[key: string]: { - type: 'preToolCall' | 'postToolCall' | 'preRequest' | 'postRequest'; - matcher: string; + type: 'sessionStart' | 'sessionEnd' | 'chatStart' | 'chatEnd' | + 'preRequest' | 'postRequest' | 'preToolCall' | 'postToolCall'; + matcher?: string; // regex for server__tool-name, only *ToolCall hooks visible?: boolean; + runOnError?: boolean; // postToolCall only actions: { type: 'shell'; - shell: string; + shell?: string; // inline script + file?: string; // path to script file + timeout?: number; // ms, default 30000 }[]; }; }; diff --git a/docs/examples.md b/docs/examples.md index 3cfe643d..bf0d1d9b 100644 --- a/docs/examples.md +++ b/docs/examples.md @@ -5,6 +5,60 @@ ECA config examples showing the power of its features and flexibility If you think your config is relevant to be shared for other people, [open a pull request here](https://github.com/editor-code-assistant/eca/edit/master/docs/examples.md) ## From users +??? info "Hook: fix unbalanced CLJ parens (@zikajk)" + + First install latest [[babashka](https://github.com/babashka/babashka)] + [[bbin](https://github.com/babashka/bbin)]. + Then run: + ```bbin install https://github.com/bhauman/clojure-mcp-light.git --as clj-paren-repair --main-opts '["-m" "clojure-mcp-light.paren-repair"]'``` + + ```javascript title="config.json" + {... + "hooks: {"CLJ-balanced-parens-check": {"type":"postToolCall", + "matcher": "eca__write_file|eca__edit_file", + "actions": [{"type": "shell", + "file": "hooks/clj_check_parens.sh"}]}} + ...} + ``` + + ```bash title="hooks/clj_check_parens.sh" + # Hook to check Clojure files with clj-kondo and auto-repair parens + + # Read stdin and extract path (returns empty string if null/invalid) + file_path=$(jq -r '.tool_input.path // empty' 2>/dev/null) + + # Helper function to generate JSON output + respond() { + cat </dev/null + if [ $? -ne 3 ]; then + respond true + exit 0 + fi + + # 3. Attempt Repair + if clj-paren-repair "$file_path" &>/dev/null; then + respond false "Unbalanced parens fixed." "Unbalanced parens have been automatically fixed." + else + respond false "Unbalanced parens not fixed!" "Unbalanced parens couldn't be automatically fixed. Tell user to fix it manually." + fi + + exit 0 + ``` ??? info "Custom behavior: Clojure reviewer (@zikajk)" @@ -19,55 +73,55 @@ If you think your config is relevant to be shared for other people, [open a pull "defaultModel": "deepseek/deepseek-chat", "toolCall": {"approval": {"byDefault": "allow"}} } - + } ``` - + ```markdown title="prompts/reviwer.md" You are a Principal Clojure(Script) Engineer, acting as a wise and pragmatic code reviewer. Your mindset is shaped by the design principles of Rich Hickey and the practical wisdom found in texts like "Elements of Clojure," "Functional Design," and "Programming Clojure." Your tone is constructive; your goal is to help, not just to criticize. - + Review the following staged changes, which are part of a large, monolithic codebase. Your goal is not just to find errors, but to elevate the code's design, maintainability, and simplicity. - + Deliver production-quality solutions that meet the stated scope, nothing more and nothing less. Prefer clarity, simplicity, and testability over cleverness. Design for change. Always apply the **Boy Scout Rule**: leave the code a little cleaner than you found it. - + Your review must be concise and provide actionable feedback. Focus on the following key areas, adhering to these hard rules. - + ### 1. Structure and Size (Measurable Rules) - **Nesting and Complexity:** Look for deeply nested structures (`let`, `if`, `cond`). If the code requires more than 2-3 levels of nesting, it's a signal to refactor. Suggest extracting logic into separate functions. - **No Magic Values:** Are there "magic" numbers or strings in the code? Suggest replacing them with named constants (`def` or `defconst`). - + ### 2. State Management and Side Effects - **Purity:** Prefer pure functions. Are side effects (I/O, database, time, randomness) clearly separated from the core logic? - **Explicit Side Effects:** Are functions with side effects clearly named (e.g., with a `!` suffix)? Are these effects contained at the system's boundaries? - **Correct Atom Usage:** Is an `atom` used for simple, uncoordinated state? Is there complex logic hidden within it that deserves a better model (e.g., a state machine)? - + ### 3. Idiomatic Clojure & Code Smells - **Idiomatic Core Usage:** Does the code make full use of `clojure.core` functions (e.g., `update`, `get-in`, sequence functions) instead of manual re-implementations? - **Duplication (DRY):** Identify any copied code block (approx. **5+ lines**) and suggest extracting it into a reusable function. - **Primitive Obsession:** Does the code work with too many simple types (strings, numbers) where a structured data type would make more sense? Suggest using `defrecord` or validation with `clojure.spec`/`malli` to create small "value objects." - **Error Handling:** Is error handling robust? Prefer exceptions with rich context (`ex-info`) over returning `nil` for control flow, unless it is an explicit and expected outcome. - **Boundary Validation & Schema** Does this function operate at a system boundary (e.g., an API handler, event consumer, or reading from a database)? If so, and it lacks input validation, suggest adding a schema (using the project's standard like clojure.spec, malli or plumatic.schema) to define and enforce the data's shape. This prevents invalid data from propagating deep into the system. - + ### 4. Consistency and Context - **Internal API / Patterns:** Does the new code respect existing patterns and idioms within the codebase? - **Reusability:** Could an existing helper function from the codebase have been used instead of writing a new one? If so, suggest it. - **Use Existing Accessor Functions** Identify direct keyword access to nested data structures (e.g., (:bill/reversal-method bill)). Check if a dedicated helper or accessor function (like (bill/reversal-method bill)) already exists for this purpose—especially if one was just introduced in the same set of changes. If so, recommend its use to encapsulate the data structure and respect the single source of truth. - + ### 5. Testing - **Critical Tests:** Identify logic that is critical or complex. Suggest **2-3 specific test cases** that should be added (e.g., happy path, an edge case, an error state). The goal is not 100% coverage, but verifying the most important scenarios. - + Provide your feedback as a clear, numbered list. For each point, use the following structure: - **ISSUE:** A brief and clear description of the problem. - **REASON:** An explanation of why it's a problem (e.g., "it reduces readability," "it increases the risk of bugs"). - **SUGGESTION:** A concrete, actionable recommendation, ideally with a small code snippet demonstrating the improved approach. - + Frame your points constructively and clearly. ``` @@ -93,10 +147,10 @@ If you think your config is relevant to be shared for other people, [open a pull } } ``` - + ```markdown title="tools/clj-nrepl-eval.md" Evaluate Clojure code in the project's nREPL session. Returns the result of evaluation with stdout/stderr captured. - + Usage: - `code` parameter accepts Clojure expressions as a string - State persists between calls (defined vars/functions remain available) @@ -107,7 +161,7 @@ If you think your config is relevant to be shared for other people, [open a pull (+ x y)) - Strings WITHOUT single quotes: Use normally - Example: (str \"Hello World\") Example: (println \"The result is ready\") + Example: (str \"Hello World\") Example: (println \"The result is ready\") - Strings WITH single quotes: Use \\' to escape them Example: (str \"It\\'s working\") Example: (println \"That\\'s correct\") @@ -116,7 +170,7 @@ If you think your config is relevant to be shared for other people, [open a pull Example: (str \"Hello \" \"World\") DO NOT USE: (str \\\"Say \\\"hello\\\"\\\") This will break - Quote syntax: Use (quote x) instead of 'x - Example: (require (quote [clojure.string :as str])) Alternative: If you need 'x syntax use \\x27 (hex) Example: (def x \\x27symbol) + Example: (require (quote [clojure.string :as str])) Alternative: If you need 'x syntax use \\x27 (hex) Example: (def x \\x27symbol) - Backslashes: Use \\\\ for literal backslash (standard escaping) Example: (re-find #\\\"\\\\d+\\\" \\\"abc123\\\") Example: (str \\\"path\\\\\\\\to\\\\\\\\file\\\") \\\"path\\\\to\\\\file\\\" @@ -129,4 +183,3 @@ If you think your config is relevant to be shared for other people, [open a pull (str/upper-case \"test\") - Very large outputs may be truncated ``` - diff --git a/integration-test/entrypoint.clj b/integration-test/entrypoint.clj index 891779c8..ea1052be 100755 --- a/integration-test/entrypoint.clj +++ b/integration-test/entrypoint.clj @@ -3,10 +3,12 @@ [babashka.process :refer [shell]] [clojure.test :as t] [integration.eca :as eca] + [integration.chat.hooks-test] [llm-mock.server :as llm-mock.server])) (def namespaces '[integration.initialize-test + integration.chat.hooks-test integration.chat.openai-test integration.chat.anthropic-test integration.chat.github-copilot-test diff --git a/integration-test/integration/chat/hooks_test.clj b/integration-test/integration/chat/hooks_test.clj new file mode 100644 index 00000000..4325c2a9 --- /dev/null +++ b/integration-test/integration/chat/hooks_test.clj @@ -0,0 +1,389 @@ +(ns integration.chat.hooks-test + (:require + [clojure.java.io :as io] + [clojure.string :as string] + [cheshire.core :as json] + [clojure.test :refer [deftest is testing]] + [integration.eca :as eca] + [integration.fixture :as fixture] + [integration.helper :as h] + [llm-mock.mocks :as llm.mocks] + [matcher-combinators.matchers :as m] + [matcher-combinators.test :refer [match?]])) + +(eca/clean-after-test) + +(defn- hooks-init-options [hooks] + (assoc fixture/default-init-options :hooks hooks)) + +(deftest prerequest-chaining-and-stop-test + (testing "preRequest chaining rewrites prompt and stop prevents LLM call" + (eca/start-process!) + + (llm.mocks/set-case! :simple-text-0) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"rewrite" {:type "preRequest" + :actions [{:type "shell" + :shell "echo '{\"replacedPrompt\":\"REWRITTEN\"}'"}]} + "stop" {:type "preRequest" + :actions [{:type "shell" + :shell "echo '{\"continue\":false,\"stopReason\":\"STOPPED BY HOOK\"}'"}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-4.1" + :message "ORIGINAL"})) + chat-id (:chatId resp) + notifications (loop [acc []] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (if (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state]))) + (conj acc n) + (recur (conj acc n)))))] + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-4.1" + :status "prompting"} + resp)) + + ;; System receives stopReason from hook and finishes. + (is (match? + (m/embeds + [{:chatId chat-id + :role "system" + :content {:type "text" :text "STOPPED BY HOOK"}} + {:chatId chat-id + :role "system" + :content {:type "progress" :state "finished"}}]) + notifications)) + + ;; LLM must not be called when continue:false. + (is (nil? (llm.mocks/get-req-body :simple-text-0)))))) + +(deftest pretoolcall-updated-input-propagates-to-llm-test + (testing "preToolCall updatedInput is reflected in next LLM call" + (eca/start-process!) + + (llm.mocks/set-case! :tool-calling-0) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"pre-tool" {:type "preToolCall" + :actions [{:type "shell" + :shell "echo '{\"updatedInput\":{\"recursive\":true}}'"}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-5" + :message "What files you see?"})) + chat-id (:chatId resp) + ;; Drain notifications until tool flow ends (progress finished) + _ (loop [] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (when (not (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state])))) + (recur))))] + + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-5" + :status "prompting"} + resp)) + + ;; The second OpenAI responses call (captured under :tool-calling-0) + ;; should see the updated arguments with recursive=true. + (is (match? + {:input (m/embeds + [{:type "function_call" + :name "eca__directory_tree" + :arguments (m/pred #(and (string? %) + (re-find #"\"recursive\":true" %)))}])} + (llm.mocks/get-req-body :tool-calling-0)))))) + +(deftest lifecycle-hooks-order-test + (testing "sessionStart, chatStart, chatEnd, sessionEnd ordering" + (eca/start-process!) + + (let [log-path (io/file h/default-root-project-path ".eca/hooks-log.txt") + win? (string/starts-with? (System/getProperty "os.name") "Windows")] + (io/make-parents log-path) + (spit log-path "") + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"session-start" {:type "sessionStart" + :actions [{:type "shell" + :shell "echo sessionStart >> .eca/hooks-log.txt"}]} + "chat-start" {:type "chatStart" + :actions [{:type "shell" + :shell "printf 'chatStart:%s\\n' \"$(jq -r '.resumed')\" >> .eca/hooks-log.txt"}]} + "chat-end" {:type "chatEnd" + :actions [{:type "shell" + :shell "echo chatEnd >> .eca/hooks-log.txt"}]} + "session-end" {:type "sessionEnd" + :actions [{:type "shell" + :shell "echo sessionEnd >> .eca/hooks-log.txt"}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (llm.mocks/set-case! :simple-text-0) + + ;; Start new chat + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-4.1" + :message "Hello"})) + chat-id (:chatId resp)] + (is (string? chat-id)) + + ;; Resume existing chat + (eca/request! (fixture/chat-prompt-request + {:chat-id chat-id + :model "openai/gpt-4.1" + :message "Resume"})) + + ;; Delete chat to trigger chatEnd. + (eca/request! [:chat/delete {:chat-id chat-id}])) + + ;; Shutdown session to trigger sessionEnd. + (eca/request! (fixture/shutdown-request)) + (eca/notify! (fixture/exit-notification)) + + (let [lines (->> (slurp log-path) + string/split-lines + (remove string/blank?))] + ;; Expected order: + ;; - sessionStart + ;; - chatStart:false (new chat, not resumed) + ;; - chatEnd + ;; - sessionEnd + (if win? (is (= 5 (count lines))) ;; The used command results in bad encoding in Windows etc... + (is (= (if win? + ["??sessionStart\r" "chatStart:false\r" "chatEnd\r" "sessionEnd\r" ""] + ["sessionStart" "chatStart:false" "chatEnd" "sessionEnd"]) + lines))))))) + +(deftest posttoolcall-receives-tool-response-test + (testing "postToolCall hook receives tool_response and tool_input after tool execution" + (eca/start-process!) + + (llm.mocks/set-case! :tool-calling-0) + + (let [log-path (io/file h/default-root-project-path ".eca/posttool-log.txt") + win? (string/starts-with? (System/getProperty "os.name") "Windows")] + (io/make-parents log-path) + (io/delete-file log-path true) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"post-tool" {:type "postToolCall" + :actions [{:type "shell" + ;; Use a single jq invocation to extract both values + ;; stdin is only available once per hook execution + :shell (if win? + (str "$Input | Set-Content " log-path) + (str "cat >" log-path))}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-5" + :message "What files you see?"})) + chat-id (:chatId resp) + ;; Drain notifications until progress finished + _ (loop [] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (when-not (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state]))) + (recur))))] + + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-5" + :status "prompting"} + resp)) + + (let [hook-data (json/parse-string (slurp log-path) true)] + (is (match? + {:tool_input {:path (m/pred string?)} + :tool_response [{:type "text" + :text (m/pred #(and (string? %) + (not (string/blank? %))))}] + :chat_id (m/pred string?) + :server (m/equals "eca") + :db_cache_path (m/pred string?) + :behavior (m/equals "agent") + :hook_type (m/equals "postToolCall") + :hook_name (m/equals "postTool") + :error (m/equals false) + :workspaces (m/seq-of (m/pred string?)) + :tool_name (m/equals "directory_tree")} + hook-data)) + ;; Explicitly check that we got some file listing content + (is (string/includes? (get-in hook-data [:tool_response 0 :text]) "file1.md"))))))) + +(deftest pretoolcall-approval-deny-test + (testing "preToolCall hook can reject tool calls via approval:deny" + (eca/start-process!) + + (llm.mocks/set-case! :tool-calling-0) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"deny-tool" {:type "preToolCall" + :actions [{:type "shell" + :shell "echo '{\"approval\":\"deny\",\"additionalContext\":\"Tool blocked by policy\"}'"}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-5" + :message "What files you see?"})) + chat-id (:chatId resp) + ;; Collect notifications until progress finished + notifications (loop [acc []] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (if (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state]))) + (conj acc n) + (recur (conj acc n)))))] + + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-5" + :status "prompting"} + resp)) + + ;; Verify the hook ran (name is camelCased from config key "deny-tool" -> "denyTool") + (is (some #(and (= "system" (:role %)) + (= "hookActionFinished" (get-in % [:content :type])) + (= "denyTool" (get-in % [:content :name])) + (= 0 (get-in % [:content :status]))) + notifications) + "preToolCall hook should have executed successfully") + + ;; Verify tool call was rejected + (is (some #(and (= "assistant" (:role %)) + (= "toolCallRejected" (get-in % [:content :type])) + (= "directory_tree" (get-in % [:content :name]))) + notifications) + "Tool call should have been rejected")))) + +(deftest pretoolcall-exit-code-rejection-with-stop-test + (testing "preToolCall hook exit code 2 rejects tool and continue:false stops chat" + (let [win? (string/starts-with? (System/getProperty "os.name") "Windows")] + (eca/start-process!) + + (llm.mocks/set-case! :tool-calling-0) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"reject-and-stop" {:type "preToolCall" + :actions [{:type "shell" + ;; Exit code 2 means rejection, with continue:false and stopReason + :shell (if win? + "Write-Output '{\"continue\":false,\"stopReason\":\"Security policy violation\"}'; exit 2" + "echo '{\"continue\":false,\"stopReason\":\"Security policy violation\"}' && exit 2")}]}})}))) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-5" + :message "What files you see?"})) + chat-id (:chatId resp) + ;; Collect notifications until progress finished + notifications (loop [acc []] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (if (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state]))) + (conj acc n) + (recur (conj acc n)))))] + + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-5" + :status "prompting"} + resp)) + + ;; Verify tool call was rejected + (is (some #(and (= "assistant" (:role %)) + (= "toolCallRejected" (get-in % [:content :type])) + (= "directory_tree" (get-in % [:content :name]))) + notifications) + "Tool call should have been rejected") + + ;; Verify stopReason was displayed + (is (some #(and (= "system" (:role %)) + (= "text" (get-in % [:content :type])) + (= "Security policy violation" (get-in % [:content :text]))) + notifications) + "Stop reason should have been displayed")))) + +(deftest prerequest-additional-context-test + (testing "preRequest hook additionalContext is appended to user message" + (eca/start-process!) + + (llm.mocks/set-case! :simple-text-0) + + (eca/request! + (fixture/initialize-request + {:initializationOptions + (hooks-init-options + {"add-context" {:type "preRequest" + :actions [{:type "shell" + :shell "echo '{\"additionalContext\":\"INJECTED_CONTEXT_FROM_HOOK\"}'"}]}})})) + + (eca/notify! (fixture/initialized-notification)) + + (let [resp (eca/request! (fixture/chat-prompt-request + {:model "openai/gpt-4.1" + :message "Hello"})) + chat-id (:chatId resp) + ;; Drain notifications until finished + _ (loop [] + (let [n (eca/client-awaits-server-notification :chat/contentReceived)] + (when-not (and (= chat-id (:chatId n)) + (= "system" (:role n)) + (= "progress" (get-in n [:content :type])) + (= "finished" (get-in n [:content :state]))) + (recur))))] + + (is (match? + {:chatId (m/pred string?) + :model "openai/gpt-4.1" + :status "prompting"} + resp)) + + ;; The LLM request should contain the additionalContext wrapped in XML + (is (match? + {:input (m/embeds + [{:role "user" + :content (m/embeds + [{:type "input_text" + :text (m/pred #(string/includes? % "INJECTED_CONTEXT_FROM_HOOK"))}])}])} + (llm.mocks/get-req-body :simple-text-0)))))) diff --git a/src/eca/cache.clj b/src/eca/cache.clj new file mode 100644 index 00000000..0e0b9ee2 --- /dev/null +++ b/src/eca/cache.clj @@ -0,0 +1,37 @@ +(ns eca.cache + "Cache directory and file management utilities." + (:require + [babashka.fs :as fs] + [clojure.java.io :as io] + [clojure.string :as string])) + +(set! *warn-on-reflection* true) + +(defn global-dir + "Returns the File object for ECA's global cache directory." + [] + (let [cache-home (or (System/getenv "XDG_CACHE_HOME") + (io/file (System/getProperty "user.home") ".cache"))] + (io/file cache-home "eca"))) + +(defn workspaces-hash + "Returns an 8-char base64 (URL-safe, no padding) hash key for the given workspace set." + [workspaces uri->filename-fn] + (let [paths (->> workspaces + (map #(str (fs/absolutize (fs/file (uri->filename-fn (:uri %)))))) + (distinct) + (sort)) + joined (string/join ":" paths) + md (java.security.MessageDigest/getInstance "SHA-256") + digest (.digest (doto md (.update (.getBytes joined "UTF-8")))) + encoder (-> (java.util.Base64/getUrlEncoder) + (.withoutPadding)) + key (.encodeToString encoder digest)] + (subs key 0 (min 8 (count key))))) + +(defn workspace-cache-file + "Returns a File object for a workspace-specific cache file." + [workspaces filename uri->filename-fn] + (io/file (global-dir) + (workspaces-hash workspaces uri->filename-fn) + filename)) diff --git a/src/eca/db.clj b/src/eca/db.clj index 891cd7ea..939a48f7 100644 --- a/src/eca/db.clj +++ b/src/eca/db.clj @@ -2,9 +2,8 @@ (:require [babashka.fs :as fs] [clojure.java.io :as io] - [clojure.string :as string] [cognitect.transit :as transit] - [eca.config :as config :refer [get-env get-property]] + [eca.cache :as cache] [eca.logger :as logger] [eca.metrics :as metrics] [eca.shared :as shared]) @@ -123,32 +122,11 @@ (proxy-super flush) (proxy-super close))))) -(defn ^:private global-cache-dir [] - (let [cache-home (or (get-env "XDG_CACHE_HOME") - (io/file (get-property "user.home") ".cache"))] - (io/file cache-home "eca"))) - -(defn ^:private workspaces-hash - "Return an 8-char base64 (URL-safe, no padding) key for the given - workspace set." - [workspaces] - (let [paths (->> workspaces - (map #(str (fs/absolutize (fs/file (shared/uri->filename (:uri %)))))) - (distinct) - (sort)) - joined (string/join ":" paths) - md (java.security.MessageDigest/getInstance "SHA-256") - digest (.digest (doto md (.update (.getBytes joined "UTF-8")))) - encoder (-> (java.util.Base64/getUrlEncoder) - (.withoutPadding)) - key (.encodeToString encoder digest)] - (subs key 0 (min 8 (count key))))) +(defn ^:private transit-global-db-file [] + (io/file (cache/global-dir) "db.transit.json")) (defn ^:private transit-global-by-workspaces-db-file [workspaces] - (io/file (global-cache-dir) (workspaces-hash workspaces) "db.transit.json")) - -(defn ^:private transit-global-db-file [] - (io/file (global-cache-dir) "db.transit.json")) + (cache/workspace-cache-file workspaces "db.transit.json" shared/uri->filename)) (defn ^:private read-cache [cache-file metrics] (try diff --git a/src/eca/features/chat.clj b/src/eca/features/chat.clj index ec29d023..e5ce6d82 100644 --- a/src/eca/features/chat.clj +++ b/src/eca/features/chat.clj @@ -46,22 +46,57 @@ :name name :id id}))) -(defn ^:private notify-after-hook-action! [chat-ctx {:keys [id name output error status type visible?]}] - (when visible? +(defn ^:private format-hook-output + "Format hook output for display, showing parsed JSON fields or raw output." + [{:keys [systemMessage replacedPrompt additionalContext] :as parsed} raw-output] + (if parsed + (cond-> (or systemMessage "Hook executed") + replacedPrompt (str "\nReplacedPrompt: " (pr-str replacedPrompt)) + additionalContext (str "\nAdditionalContext: " additionalContext)) + raw-output)) + +(defn ^:private notify-after-hook-action! [chat-ctx {:keys [id name parsed raw-output raw-error exit type visible?]}] + (when (and visible? (not (:suppressOutput parsed))) (send-content! chat-ctx :system {:type :hookActionFinished :action-type type :id id :name name - :status status - :output output - :error error}))) + :status exit + :output (format-hook-output parsed raw-output) + :error raw-error}))) + +(defn ^:private wrap-additional-context + "Return XML-wrapped additional context attributed to `from`." + [from content] + (format "\n%s\n" + (name from) + content)) + +(defn ^:private append-post-tool-additional-context! + "Append additionalContext (wrapped as XML) from a postToolCall hook to the + matching tool_call_output message so LLM sees it in the next round." + [db* chat-id tool-call-id hook-name additional-context] + (when (not (string/blank? additional-context)) + (let [entry {:type :text :text (wrap-additional-context hook-name additional-context)}] + (swap! db* update-in [:chats chat-id :messages] + ;; Optimized: Scans messages backwards since the tool output is likely one of the last items. + #(let [idx (loop [i (dec (count %))] + (when (>= i 0) + (let [msg (nth % i)] + (if (and (= "tool_call_output" (:role msg)) + (= tool-call-id (get-in msg [:content :id]))) + i + (recur (dec i))))))] + (if idx + (update-in % [idx :content :output :contents] conj entry) + %)))))) (defn finish-chat-prompt! [status {:keys [message chat-id db* metrics config on-finished-side-effect] :as chat-ctx}] (swap! db* assoc-in [:chats chat-id :status] status) (f.hooks/trigger-if-matches! :postRequest - {:chat-id chat-id - :prompt message} + (merge (f.hooks/chat-hook-data @db* chat-id (:behavior chat-ctx)) + {:prompt message}) {:on-before-action (partial notify-before-hook-action! chat-ctx) :on-after-action (partial notify-after-hook-action! chat-ctx)} @db* @@ -82,6 +117,112 @@ (throw (ex-info "Chat prompt stopped" {:silent? true :chat-id chat-id})))) +(defn ^:private update-pre-request-state + "Pure function to compute new state from hook result." + [{:keys [final-prompt additional-contexts stop?]} {:keys [parsed raw-output exit]} action-name] + (let [replaced-prompt (:replacedPrompt parsed) + additional-context (if parsed + (:additionalContext parsed) + raw-output) + success? (= 0 exit)] + {:final-prompt (if (and replaced-prompt success?) + replaced-prompt + final-prompt) + :additional-contexts (if (and additional-context success?) + (conj additional-contexts + {:hook-name action-name :content additional-context}) + additional-contexts) + :stop? (or stop? + (false? (get parsed :continue true)))})) + +(defn ^:private run-pre-request-action! + "Run a single preRequest hook action, updating the accumulator state. + + State is a map: + - :final-prompt + - :additional-contexts + - :stop? (true when any hook requests stop)" + [db chat-ctx chat-id hook hook-name idx action state] + (if (:stop? state) + state + (let [id (str (random-uuid)) + action-type (:type action) + action-name (if (> (count (:actions hook)) 1) + (str hook-name "-" (inc idx)) + hook-name) + visible? (get hook :visible true)] + (notify-before-hook-action! chat-ctx {:id id + :visible? visible? + :name action-name}) + ;; Run the hook action + (if-let [result (f.hooks/run-hook-action! action + action-name + :preRequest + (merge (f.hooks/chat-hook-data db chat-id (:behavior chat-ctx)) + {:prompt (:final-prompt state)}) + db)] + (let [{:keys [parsed raw-output raw-error exit]} result + should-continue? (get parsed :continue true)] + ;; Notify after action + (notify-after-hook-action! chat-ctx (merge result + {:id id + :name action-name + :type action-type + :visible? visible? + :status exit + :output raw-output + :error raw-error})) + ;; Check if hook wants to stop + (when (false? should-continue?) + (when-let [stop-reason (:stopReason parsed)] + (send-content! chat-ctx :system {:type :text :text stop-reason})) + (finish-chat-prompt! :idle chat-ctx)) + ;; Update accumulator + (update-pre-request-state state + result + action-name)) + ;; No result from action + (do + (notify-after-hook-action! chat-ctx {:id id + :name action-name + :visible? visible? + :type action-type + :exit 1 + :status 1}) + state))))) + +(defn ^:private run-pre-request-hook! + "Run all actions for a single preRequest hook, threading state." + [db chat-ctx chat-id state [hook-name hook]] + (reduce + (fn [s [idx action]] + (if (:stop? s) + (reduced s) + (run-pre-request-action! db chat-ctx chat-id hook (name hook-name) idx action s))) + state + (map-indexed vector (:actions hook)))) + +(defn ^:private run-pre-request-hooks! + "Run preRequest hooks with chaining support. + + Returns a map with: + - :final-prompt + - :additional-contexts (vector of {:hook-name name :content context}) + - :stop? (true when any hook requests stop)" + [{:keys [db* config chat-id message] :as chat-ctx}] + (let [db @db*] + (reduce + (fn [state hook-entry] + (if (:stop? state) + (reduced state) + (run-pre-request-hook! db chat-ctx chat-id state hook-entry))) + {:final-prompt message + :additional-contexts [] + :stop? false} + (->> (:hooks config) + (filter #({"preRequest" "prePrompt"} (:type (val %)))) + (sort-by key))))) + ;;; Helper functions for tool call state management (defn ^:private get-tool-call-state @@ -99,6 +240,34 @@ (#{:completed :rejected} (:status state)))) (into {}))) +(defn ^:private run-post-tool-call-hooks! + "Run postToolCall hooks and append any additionalContext to the tool output." + [db* chat-ctx tool-call-id event-data] + (let [tool-call-state (get-tool-call-state @db* (:chat-id chat-ctx) tool-call-id) + chat-id (:chat-id chat-ctx)] + (f.hooks/trigger-if-matches! + :postToolCall + (merge (f.hooks/chat-hook-data @db* chat-id (:behavior chat-ctx)) + {:tool-name (:name tool-call-state) + :server (:server tool-call-state) + :tool-input (:arguments tool-call-state) + :tool-response (:outputs event-data) + :error (:error event-data)}) + {:on-before-action (partial notify-before-hook-action! chat-ctx) + :on-after-action (fn [{:keys [parsed name] :as result}] + ;; Always notify UI + (notify-after-hook-action! chat-ctx result) + ;; If hook provided additionalContext, append as XML to the tool output + (when-let [ac (:additionalContext parsed)] + (append-post-tool-additional-context! + (:db* chat-ctx) + (:chat-id chat-ctx) + tool-call-id + name + ac)))} + @db* + (:config chat-ctx)))) + ;;; Event-driven state machine for tool calls (def ^:private tool-call-state-machine @@ -180,7 +349,7 @@ [:waiting-approval :hook-rejected] {:status :rejected - :actions [:set-decision-reason :deliver-approval-false]} + :actions [:set-decision-reason :set-hook-continue :set-hook-stop-reason :deliver-approval-false]} [:waiting-approval :user-reject] {:status :rejected @@ -192,7 +361,7 @@ [:execution-approved :hook-rejected] {:status :rejected - :actions [:set-decision-reason]} + :actions [:set-decision-reason :set-hook-continue :set-hook-stop-reason]} [:execution-approved :execution-start] {:status :executing @@ -200,7 +369,7 @@ [:executing :execution-end] {:status :cleanup - :actions [:deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} + :actions [:save-execution-result :deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} [:cleanup :cleanup-finished] {:status :completed @@ -220,7 +389,7 @@ [:stopping :stop-attempted] {:status :cleanup - :actions [:deliver-future-cleanup-completed :send-toolCallRejected]} + :actions [:save-execution-result :deliver-future-cleanup-completed :send-toolCallRejected]} ;; And now all the :stop-requested transitions @@ -269,6 +438,11 @@ [action db* chat-ctx tool-call-id event-data] (case action ;; Notification actions + :save-execution-result + (swap! db* update-in [:chats (:chat-id chat-ctx) :tool-calls tool-call-id] + merge + (select-keys event-data [:outputs :error :total-time-ms])) + :send-progress (send-content! chat-ctx :system {:type :progress @@ -345,17 +519,7 @@ :summary (:summary event-data)))) :trigger-post-tool-call-hook - (let [tool-call-state (get-tool-call-state @db* (:chat-id chat-ctx) tool-call-id)] - (f.hooks/trigger-if-matches! - :postToolCall - {:chat-id (:chat-id chat-ctx) - :tool-name (:name tool-call-state) - :server (:server tool-call-state) - :arguments (:arguments tool-call-state)} - {:on-before-action (partial notify-before-hook-action! chat-ctx) - :on-after-action (partial notify-after-hook-action! chat-ctx)} - @db* - (:config chat-ctx))) + (run-post-tool-call-hooks! db* chat-ctx tool-call-id event-data) ;; Actions on parts of the state :deliver-approval-false @@ -415,6 +579,14 @@ (swap! db* assoc-in [:chats (:chat-id chat-ctx) :tool-calls tool-call-id :decision-reason] (:reason event-data)) + :set-hook-continue + (swap! db* assoc-in [:chats (:chat-id chat-ctx) :tool-calls tool-call-id :hook-continue] + (:hook-continue event-data)) + + :set-hook-stop-reason + (swap! db* assoc-in [:chats (:chat-id chat-ctx) :tool-calls tool-call-id :hook-stop-reason] + (:hook-stop-reason event-data)) + :set-start-time (swap! db* assoc-in [:chats (:chat-id chat-ctx) :tool-calls tool-call-id :start-time] (:start-time event-data)) @@ -532,362 +704,468 @@ {:type :prompt-message :message message}))) -(defn ^:private prompt-messages! - [user-messages - {:keys [db* config chat-id behavior full-model instructions messenger metrics] :as chat-ctx}] - (let [[provider model] (string/split full-model #"/" 2) - _ (f.login/maybe-renew-auth-token! - {:provider provider - :on-renewing (fn [] - (send-content! chat-ctx :system {:type :progress - :state :running - :text "Renewing auth token"})) - :on-error (fn [error-msg] - (send-content! chat-ctx :system {:type :text - :text error-msg}) - (finish-chat-prompt! :idle chat-ctx) - (throw (ex-info "Auth token renew failed" {})))} - chat-ctx) - db @db* - past-messages (get-in db [:chats chat-id :messages] []) - model-capabilities (get-in db [:models full-model]) - provider-auth (get-in @db* [:auth provider]) - all-tools (f.tools/all-tools chat-id behavior @db* config) - received-msgs* (atom "") - reasonings* (atom {}) - add-to-history! (fn [msg] - (swap! db* update-in [:chats chat-id :messages] (fnil conj []) msg)) - on-usage-updated (fn [usage] - (when-let [usage (shared/usage-msg->usage usage full-model chat-ctx)] - (send-content! chat-ctx :system - (merge {:type :usage} - usage))))] - - (when-not (get-in db [:chats chat-id :title]) - (future* config - (when-let [{:keys [output-text]} (llm-api/sync-prompt! - {:provider provider - :model model - :model-capabilities (assoc model-capabilities - :reason? false - :tools false - :web-search false) - :instructions (f.prompt/title-prompt) - :user-messages user-messages - :config config - :provider-auth provider-auth})] - (when output-text - (let [title (subs output-text 0 (min (count output-text) 30))] - (swap! db* assoc-in [:chats chat-id :title] title) - (send-content! chat-ctx :system (assoc-some - {:type :metadata} - :title title)) - ;; user prompt responded faster than title was generated - (when (= :idle (get-in @db* [:chats chat-id :status])) - (db/update-workspaces-cache! @db* metrics))))))) - (send-content! chat-ctx :system {:type :progress - :state :running - :text "Waiting model"}) - ;; We spawn a new future to not block the lsp4clj thread - ;; in case a tool call approval is needed - (future* config - (llm-api/sync-or-async-prompt! - {:model model - :provider provider - :model-capabilities model-capabilities - :user-messages user-messages - :instructions instructions - :past-messages past-messages - :config config - :tools all-tools - :provider-auth provider-auth - :on-first-response-received (fn [& _] - (assert-chat-not-stopped! chat-ctx) - (doseq [message user-messages] - (add-to-history! (assoc message :content-id (:user-content-id chat-ctx)))) - (send-content! chat-ctx :system {:type :progress - :state :running - :text "Generating"})) - :on-usage-updated on-usage-updated - :on-message-received (fn [{:keys [type] :as msg}] - (assert-chat-not-stopped! chat-ctx) - (case type - :text (do - (swap! received-msgs* str (:text msg)) - (send-content! chat-ctx :assistant {:type :text - :text (:text msg)})) - :url (send-content! chat-ctx :assistant {:type :url - :title (:title msg) - :url (:url msg)}) - :limit-reached (do - (send-content! chat-ctx :system - {:type :text - :text (str "API limit reached. Tokens: " (json/generate-string (:tokens msg)))}) - - (finish-chat-prompt! :idle chat-ctx)) - :finish (do - (add-to-history! {:role "assistant" - :content [{:type :text :text @received-msgs*}]}) - (finish-chat-prompt! :idle chat-ctx)))) - :on-prepare-tool-call (fn [{:keys [id full-name arguments-text]}] - (assert-chat-not-stopped! chat-ctx) - (let [tool (tool-by-full-name full-name all-tools)] - (transition-tool-call! db* chat-ctx id :tool-prepare - {:name (:name tool) - :server (:name (:server tool)) - :full-name full-name - :origin (:origin tool) - :arguments-text arguments-text - :summary (f.tools/tool-call-summary all-tools full-name nil config)}))) - :on-tools-called (fn [tool-calls] - ;; If there are multiple tool calls, they are allowed to execute concurrently. - (assert-chat-not-stopped! chat-ctx) - ;; Flush any pending assistant text once before processing multiple tool calls - (when-not (string/blank? @received-msgs*) - (add-to-history! {:role "assistant" :content [{:type :text :text @received-msgs*}]}) - (reset! received-msgs* "")) - (let [any-rejected-tool-call?* (atom nil)] - (run! (fn do-tool-call [{:keys [id full-name arguments] :as tool-call}] - (let [approved?* (promise) ; created here, stored in the state. - db @db* - tool (tool-by-full-name full-name all-tools) - hook-approved?* (atom true) - origin (:origin tool) - name (:name tool) - server (:server tool) - server-name (:name server) - approval (f.tools/approval all-tools tool arguments db config behavior) - ask? (= :ask approval) - details (f.tools/tool-call-details-before-invocation name arguments server db ask?) - summary (f.tools/tool-call-summary all-tools full-name arguments config)] - ;; assert: In :preparing or :stopping or :cleanup - ;; Inform client the tool is about to run and store approval promise - (when-not (#{:stopping :cleanup} (:status (get-tool-call-state db chat-id id))) - (transition-tool-call! db* chat-ctx id :tool-run - {:approved?* approved?* - :future-cleanup-complete?* (promise) +(defn ^:private process-pre-tool-call-hook-result + "Pure function: fold a single hook result into accumulated state. + + acc is {:hook-results [], :approval-override nil, :hook-rejected? false, + :hook-rejection-reason nil, :hook-continue true, :hook-stop-reason nil}" + [acc result] + (let [parsed (:parsed result) + hook-approval (:approval parsed) + exit-code-2? (= f.hooks/hook-rejection-exit-code (:exit result))] + (cond-> (update acc :hook-results conj result) + ;; Handle rejection (exit code 2 or explicit deny) + (or exit-code-2? (= "deny" hook-approval)) + (merge {:hook-rejected? true + :hook-rejection-reason (or (:additionalContext parsed) + (:raw-error result) + "Tool call rejected by hook") + :hook-continue (get parsed :continue true) + :hook-stop-reason (:stopReason parsed)}) + + ;; Handle approval override (allow/ask) when not exit-code-2 + (and hook-approval (not exit-code-2?)) + (assoc :approval-override hook-approval)))) + +(defn ^:private decide-tool-call-action + "Decides what action to take for a tool call, running hooks and collecting their results. + + Returns a plan (data) with: + - :decision (:ask | :allow | :deny) + - :arguments (potentially modified by hooks) + - :approval-override (from hooks) + - :hook-rejected? (boolean) + - :reason (map with :code and :text, when decision is :allow or :deny) + - :hook-continue (boolean, for hook rejections) + - :hook-stop-reason (string, for hook rejections) + + The on-before-hook-action and on-after-hook-action callbacks are optional (default to noops) + and are used for UI notifications. In tests, these can be omitted." + [{:keys [full-name arguments]} all-tools db config behavior chat-id + & [{:keys [on-before-hook-action on-after-hook-action] + :or {on-before-hook-action (fn [_] nil) + on-after-hook-action (fn [_] nil)}}]] + (let [tool (tool-by-full-name full-name all-tools) + name (:name tool) + server (:server tool) + server-name (:name server) + + ;; 1. Determine initial config-based approval + initial-approval (f.tools/approval all-tools tool arguments db config behavior) + + ;; 2. Run hooks to collect modifications and approval overrides + hook-state* (atom {:hook-results [] + :approval-override nil + :hook-rejected? false + :hook-rejection-reason nil + :hook-continue true + :hook-stop-reason nil}) + + _ (f.hooks/trigger-if-matches! + :preToolCall + (merge (f.hooks/chat-hook-data db chat-id behavior) + {:tool-name name + :server server-name + :tool-input arguments + :approval initial-approval}) + {:on-before-action on-before-hook-action + :on-after-action (fn [result] + (on-after-hook-action result) + (swap! hook-state* process-pre-tool-call-hook-result result))} + db + config) + + ;; 3. Merge all updatedInput from hooks + {:keys [hook-results approval-override hook-rejected? + hook-rejection-reason hook-continue hook-stop-reason]} @hook-state* + updated-inputs (keep #(get-in % [:parsed :updatedInput]) hook-results) + final-arguments (if (not-empty updated-inputs) + (reduce merge arguments updated-inputs) + arguments) + arguments-modified? (boolean (seq updated-inputs)) + + ;; 4. Determine Final Approval (Hook Override > Config, but hook rejection takes precedence) + final-decision (cond + hook-rejected? :deny + approval-override (keyword approval-override) + :else initial-approval) + + ;; 5. Build the reason map + reason (case final-decision + :allow {:code :user-config-allow + :text "Tool call allowed by user config"} + :deny (if hook-rejected? + {:code :hook-rejected + :text hook-rejection-reason} + {:code :user-config-deny + :text "Tool call rejected by user config"}) + nil)] + + ;; Return the decision plan + (cond-> {:decision final-decision + :arguments final-arguments + :approval-override approval-override + :hook-rejected? hook-rejected? + :arguments-modified? arguments-modified?} + reason (assoc :reason reason) + hook-rejected? (assoc :hook-continue hook-continue + :hook-stop-reason hook-stop-reason)))) + +(defn ^:private find-last-user-msg-idx [messages] + ;; Returns the index of the last :role "user" message, or nil if none. + (last (keep-indexed (fn [i m] (when (= "user" (:role m)) i)) messages))) + +(defn ^:private on-tools-called! [{:keys [db* config chat-id behavior messenger metrics] :as chat-ctx} + received-msgs* add-to-history!] + (let [all-tools (f.tools/all-tools chat-id behavior @db* config)] + (fn [tool-calls] + (assert-chat-not-stopped! chat-ctx) + (when-not (string/blank? @received-msgs*) + (add-to-history! {:role "assistant" :content [{:type :text :text @received-msgs*}]}) + (reset! received-msgs* "")) + (let [rejected-tool-call-info* (atom nil)] + (run! (fn do-tool-call [{:keys [id full-name] :as tool-call}] + (let [approved?* (promise) + {:keys [origin name server]} (tool-by-full-name full-name all-tools) + server-name (:name server) + decision-plan (decide-tool-call-action + tool-call all-tools @db* config behavior chat-id + {:on-before-hook-action (partial notify-before-hook-action! chat-ctx) + :on-after-hook-action (partial notify-after-hook-action! chat-ctx)}) + {:keys [decision arguments hook-rejected? reason hook-continue + hook-stop-reason arguments-modified?]} decision-plan + _ (when arguments-modified? + (send-content! chat-ctx :system {:type :hookActionFinished + :action-type "shell" + :id (str (random-uuid)) + :name "input-modification" + :status 0 + :output "Hook modified tool arguments"})) + _ (swap! db* assoc-in [:chats chat-id :tool-calls id :arguments] arguments) + tool-call (assoc tool-call :arguments arguments) + ask? (= :ask decision) + details (f.tools/tool-call-details-before-invocation name arguments server @db* ask?) + summary (f.tools/tool-call-summary all-tools full-name arguments config)] + (when-not (#{:stopping :cleanup} (:status (get-tool-call-state @db* chat-id id))) + (transition-tool-call! db* chat-ctx id :tool-run {:approved?* approved?* + :future-cleanup-complete?* (promise) + :name name + :server server-name + :origin origin + :arguments arguments + :manual-approval ask? + :details details + :summary summary})) + (when-not (#{:stopping :cleanup :rejected} (:status (get-tool-call-state @db* chat-id id))) + (case decision + :ask (transition-tool-call! db* chat-ctx id :approval-ask {:progress-text "Waiting for tool call approval"}) + :allow (transition-tool-call! db* chat-ctx id :approval-allow {:reason reason}) + :deny (transition-tool-call! db* chat-ctx id :approval-deny {:reason reason}) + (logger/warn logger-tag "Unknown value of approval" {:approval decision :tool-call-id id}))) + (if (and @approved?* (not hook-rejected?)) + (when-not (#{:stopping :cleanup} (:status (get-tool-call-state @db* chat-id id))) + (assert-chat-not-stopped! chat-ctx) + (let [delayed-future + (delay + (future + (let [result (f.tools/call-tool! name + arguments + chat-id + id + behavior + db* + config + messenger + metrics + (partial get-tool-call-state @db* chat-id id) + (partial transition-tool-call! db* chat-ctx id)) + details (f.tools/tool-call-details-after-invocation name arguments details result) + {:keys [start-time]} (get-tool-call-state @db* chat-id id) + total-time-ms (- (System/currentTimeMillis) start-time)] + (add-to-history! {:role "tool_call" + :content (assoc tool-call + :name name + :details details + :summary summary + :origin origin + :server server-name)}) + (add-to-history! {:role "tool_call_output" + :content (assoc tool-call + :name name + :error (:error result) + :output result + :total-time-ms total-time-ms + :details details + :summary summary + :origin origin + :server server-name)}) + (let [state (get-tool-call-state @db* chat-id id) status (:status state)] + (case status + :executing (transition-tool-call! db* + chat-ctx + id + :execution-end {:origin origin + :name name + :server server-name + :arguments arguments + :error (:error result) + :outputs (:contents result) + :total-time-ms total-time-ms + :progress-text "Generating" + :details details + :summary summary}) + :stopping (transition-tool-call! db* + chat-ctx + id + :stop-attempted {:origin origin + :name name + :server server-name + :arguments arguments + :error (:error result) + :outputs (:contents result) + :total-time-ms total-time-ms + :reason :user-stop :details + details + :summary summary}) + (logger/warn logger-tag "Unexpected value of :status in tool call" {:status status}))))))] + (transition-tool-call! db* + chat-ctx + id + :execution-start {:delayed-future delayed-future + :origin origin :name name :server server-name - :origin origin :arguments arguments - :manual-approval ask? + :start-time (System/currentTimeMillis) :details details - :summary summary})) - ;; assert: In: :check-approval or :stopping or :cleanup or :rejected - (when-not (#{:stopping :cleanup :rejected} (:status (get-tool-call-state db chat-id id))) - (case approval - :ask (transition-tool-call! db* chat-ctx id :approval-ask - {:progress-text "Waiting for tool call approval"}) - :allow (transition-tool-call! db* chat-ctx id :approval-allow - {:reason {:code :user-config-allow - :text "Tool call allowed by user config"}}) - :deny (transition-tool-call! db* chat-ctx id :approval-deny - {:reason {:code :user-config-deny - :text "Tool call rejected by user config"}}) - (logger/warn logger-tag "Unknown value of approval in config" - {:approval approval :tool-call-id id}))) - (f.hooks/trigger-if-matches! :preToolCall - {:chat-id chat-id - :tool-name name - :server server-name - :arguments arguments - :approval approval} - {:on-before-action (partial notify-before-hook-action! chat-ctx) - :on-after-action (fn [result] - (when (= 2 (:status result)) - (transition-tool-call! db* chat-ctx id :hook-rejected - {:reason {:code :hook-rejected - :text (str "Tool call rejected by hook, output: " (:output result))}}) - (reset! hook-approved?* false)) - (notify-after-hook-action! chat-ctx result))} - db - config) - (if (and @approved?* @hook-approved?*) - ;; assert: In :execution-approved or :stopping or :cleanup - (when-not (#{:stopping :cleanup} (:status (get-tool-call-state @db* chat-id id))) - (assert-chat-not-stopped! chat-ctx) - (let [;; Since a future starts executing immediately, - ;; we need to delay the future so that the add-future action, - ;; used implicitly in the transition-tool-call! on the :execution-start event, - ;; can activate the future only *after* the state transition to :executing. - delayed-future - (delay - (future - ;; assert: In :executing - (let [result (f.tools/call-tool! name arguments chat-id id behavior db* config messenger metrics - (partial get-tool-call-state @db* chat-id id) - (partial transition-tool-call! db* chat-ctx id)) - details (f.tools/tool-call-details-after-invocation name arguments details result) - {:keys [start-time]} (get-tool-call-state @db* chat-id id) - total-time-ms (- (System/currentTimeMillis) start-time)] - (add-to-history! {:role "tool_call" - :content (assoc tool-call - :name name - :details details - :summary summary - :origin origin - :server server-name)}) - (add-to-history! {:role "tool_call_output" - :content (assoc tool-call - :name name - :error (:error result) - :output result - :total-time-ms total-time-ms - :details details - :summary summary - :origin origin - :server server-name)}) - ;; assert: In :executing or :stopping - (let [state (get-tool-call-state @db* chat-id id) - status (:status state)] - (case status - :executing (transition-tool-call! db* chat-ctx id :execution-end - {:origin origin - :name name - :server server-name - :arguments arguments - :error (:error result) - :outputs (:contents result) - :total-time-ms total-time-ms - :progress-text "Generating" - :details details - :summary summary}) - :stopping (transition-tool-call! db* chat-ctx id :stop-attempted - {:origin origin - :name name - :server server-name - :arguments arguments - :error (:error result) - :outputs (:contents result) - :total-time-ms total-time-ms - :reason :user-stop - :details details - :summary summary}) - (logger/warn logger-tag "Unexpected value of :status in tool call" {:status status}))))))] - (transition-tool-call! db* chat-ctx id :execution-start - {:delayed-future delayed-future - :origin origin - :name name - :server server-name - :arguments arguments - :start-time (System/currentTimeMillis) - :details details - :summary summary - :progress-text "Calling tool"}))) - ;; assert: In :rejected state - (let [tool-call-state (get-tool-call-state @db* chat-id id) - {:keys [code text]} (:decision-reason tool-call-state)] - (add-to-history! {:role "tool_call" :content tool-call}) - (add-to-history! {:role "tool_call_output" - :content (assoc tool-call :output {:error true - :contents [{:text text - :type :text}]})}) - (reset! any-rejected-tool-call?* code) - (transition-tool-call! db* chat-ctx id :send-reject - {:origin origin - :name name - :server server-name - :arguments arguments - :reason code - :details details - :summary summary}))))) - tool-calls) - (assert-chat-not-stopped! chat-ctx) - ;; assert: In :cleanup - ;; assert: Only those tool calls that have reached :executing have futures. - ;; Before we handle interrupts, we will wait for all tool calls with futures to complete naturally. - ;; Since a deref of a cancelled future *immediately* results in a CancellationException without waiting for the future to cleanup, - ;; we have to use another promise and deref that to know when the tool call is finished cleaning up. - (doseq [[tool-call-id state] (get-active-tool-calls @db* chat-id)] - (when-let [f (:future state)] - (try - (deref f) ; TODO: A timeout would be useful for tools that get into an infinite loop. - (catch java.util.concurrent.CancellationException _ - ;; The future was cancelled - ;; TODO: Why not just wait for the promise and not bother about the future? - ;; If future was cancelled, wait for the future's cleanup to finish. - (when-let [p (:future-cleanup-complete?* state)] - (logger/debug logger-tag "Caught CancellationException. Waiting for future to finish cleanup." - {:tool-call-id tool-call-id - :promise p}) - (deref p) ; TODO: May need a timeout here too, in case the tool does not clean up. - )) - (catch Throwable t - (logger/debug logger-tag "Ignoring a Throwable while deref'ing a tool call future" - {:tool-call-id tool-call-id - :ex-data (ex-data t) - :message (.getMessage t) - :cause (.getCause t)})) - (finally (try - (let [tool-call-state (get-tool-call-state @db* (:chat-id chat-ctx) tool-call-id)] - (transition-tool-call! db* chat-ctx tool-call-id :cleanup-finished - {:name (:name tool-call-state) - :full-name (:full-name tool-call-state)})) - (catch Throwable t - (logger/debug logger-tag "Ignoring an exception while finishing tool call" - {:tool-call-id tool-call-id - :ex-data (ex-data t) - :message (.getMessage t) - :cause (.getCause t)}))))))) - (if-let [reason-code @any-rejected-tool-call?*] - (do - (if (= :hook-rejected reason-code) - (do - (send-content! chat-ctx :system - {:type :text - :text "Tool rejected by hook"}) - (add-to-history! {:role "user" :content [{:type :text - :text "A user hook rejected one or more tool calls with the following reason"}]})) - (do - (send-content! chat-ctx :system - {:type :text - :text "Tell ECA what to do differently for the rejected tool(s)"}) - (add-to-history! {:role "user" :content [{:type :text - :text "I rejected one or more tool calls with the following reason"}]}))) - (finish-chat-prompt! :idle chat-ctx) - nil) - {:new-messages (get-in @db* [:chats chat-id :messages])}))) - :on-reason (fn [{:keys [status id text external-id]}] - (assert-chat-not-stopped! chat-ctx) - (case status - :started (do - (swap! reasonings* assoc-in [id :start-time] (System/currentTimeMillis)) - (send-content! chat-ctx :assistant - {:type :reasonStarted - :id id})) - :thinking (do - (swap! reasonings* update-in [id :text] str text) - (send-content! chat-ctx :assistant - {:type :reasonText - :id id - :text text})) - :finished (let [total-time-ms (- (System/currentTimeMillis) (get-in @reasonings* [id :start-time]))] - (add-to-history! {:role "reason" :content {:id id - :external-id external-id - :total-time-ms total-time-ms - :text (get-in @reasonings* [id :text])}}) - (send-content! chat-ctx :assistant - {:type :reasonFinished - :total-time-ms total-time-ms - :id id})) - nil)) - :on-error (fn [{:keys [message exception]}] - (send-content! chat-ctx :system - {:type :text - :text (or message (str "Error: " (ex-message exception)))}) - (finish-chat-prompt! :idle chat-ctx))})))) + :summary summary + :progress-text "Calling tool"}))) + (let [tool-call-state (get-tool-call-state @db* chat-id id) + {:keys [code text]} (:decision-reason tool-call-state) + effective-hook-continue (when hook-rejected? hook-continue) + effective-hook-stop-reason (when hook-rejected? hook-stop-reason)] + (add-to-history! {:role "tool_call" :content tool-call}) + (add-to-history! {:role "tool_call_output" + :content (assoc tool-call :output {:error true :contents [{:text text :type :text}]})}) + (reset! rejected-tool-call-info* {:code code + :hook-continue effective-hook-continue + :hook-stop-reason effective-hook-stop-reason}) + (transition-tool-call! db* chat-ctx id :send-reject {:origin origin + :name name + :server server-name + :arguments arguments + :reason code + :details details + :summary summary}))))) + tool-calls) + (assert-chat-not-stopped! chat-ctx) + (doseq [[tool-call-id state] (get-active-tool-calls @db* chat-id)] + (when-let [f (:future state)] + (try (deref f) + (catch java.util.concurrent.CancellationException _ + (when-let [p (:future-cleanup-complete?* state)] + (logger/debug logger-tag + "Caught CancellationException. Waiting for future to finish cleanup." + {:tool-call-id tool-call-id :promise p}) + (deref p))) + (catch Throwable t + (logger/debug logger-tag + "Ignoring a Throwable while deref'ing a tool call future" + {:tool-call-id tool-call-id + :ex-data (ex-data t) + :message (.getMessage t) + :cause (.getCause t)})) + (finally (try (let [tool-call-state (get-tool-call-state @db* (:chat-id chat-ctx) tool-call-id)] + (transition-tool-call! + db* + chat-ctx + tool-call-id + :cleanup-finished (merge {:name (:name tool-call-state) + :full-name (:full-name tool-call-state)} + (select-keys tool-call-state [:outputs :error :total-time-ms])))) + (catch Throwable t + (logger/debug logger-tag "Ignoring an exception while finishing tool call" + {:tool-call-id tool-call-id + :ex-data (ex-data t) + :message (.getMessage t) + :cause (.getCause t)}))))))) + (if-let [rejection-info @rejected-tool-call-info*] + (let [reason-code + (if (map? rejection-info) (:code rejection-info) rejection-info) + hook-continue + (when (map? rejection-info) (:hook-continue rejection-info)) + hook-stop-reason + (when (map? rejection-info) (:hook-stop-reason rejection-info))] + (if (= :hook-rejected reason-code) + (if (false? hook-continue) + (do (send-content! chat-ctx :system {:type :text + :text (or hook-stop-reason "Tool rejected by hook")}) + (finish-chat-prompt! :idle chat-ctx) nil) + {:new-messages (get-in @db* [:chats chat-id :messages])}) + (do (send-content! chat-ctx :system {:type :text + :text "Tell ECA what to do differently for the rejected tool(s)"}) + (add-to-history! {:role "user" + :content [{:type :text + :text "I rejected one or more tool calls with the following reason"}]}) + (finish-chat-prompt! :idle chat-ctx) + nil))) + {:new-messages (get-in @db* [:chats chat-id :messages])}))))) + +(defn ^:private prompt-messages! + "Send user messages to LLM with hook processing. + source-type controls hook behavior. + Run preRequest hooks before any heavy lifting. + Only :prompt-message supports rewrite, other only allow additionalContext append." + [user-messages source-type + {:keys [db* config chat-id behavior full-model instructions metrics message] :as chat-ctx}] + (let [original-text (or message (-> user-messages first :content first :text)) + modify-allowed? (= source-type :prompt-message) + run-hooks? (#{:prompt-message :eca-command :mcp-prompt} source-type) + user-messages (if run-hooks? + (let [{:keys [final-prompt additional-contexts stop?]} + (run-pre-request-hooks! (assoc chat-ctx :message original-text))] + (cond + stop? (do (finish-chat-prompt! :idle chat-ctx) nil) + :else (let [last-user-idx (or (find-last-user-msg-idx user-messages) + (dec (count user-messages))) + rewritten (if (and modify-allowed? + last-user-idx + final-prompt) + (assoc-in user-messages [last-user-idx :content 0 :text] final-prompt) + user-messages) + with-contexts (if (seq additional-contexts) + (reduce (fn [msgs {:keys [hook-name content]}] + (update-in msgs [last-user-idx :content] + #(conj (vec %) + {:type :text + :text (wrap-additional-context hook-name content)}))) + rewritten + additional-contexts) + rewritten)] + with-contexts))) + user-messages)] + (when user-messages + (swap! db* assoc-in [:chats chat-id :status] :running) + (let [[provider model] (string/split full-model #"/" 2) + _ (f.login/maybe-renew-auth-token! + {:provider provider + :on-renewing (fn [] + (send-content! chat-ctx :system {:type :progress + :state :running + :text "Renewing auth token"})) + :on-error (fn [error-msg] + (send-content! chat-ctx :system {:type :text :text error-msg}) + (finish-chat-prompt! :idle chat-ctx) + (throw (ex-info "Auth token renew failed" {})))} + chat-ctx) + db @db* + past-messages (get-in db [:chats chat-id :messages] []) + model-capabilities (get-in db [:models full-model]) + provider-auth (get-in @db* [:auth provider]) + all-tools (f.tools/all-tools chat-id behavior @db* config) + received-msgs* (atom "") + reasonings* (atom {}) + add-to-history! (fn [msg] + (swap! db* update-in [:chats chat-id :messages] (fnil conj []) msg)) + on-usage-updated (fn [usage] + (when-let [usage (shared/usage-msg->usage usage full-model chat-ctx)] + (send-content! chat-ctx :system (merge {:type :usage} usage))))] + (when-not (get-in db [:chats chat-id :title]) + (future* config + (when-let [{:keys [output-text]} (llm-api/sync-prompt! + {:provider provider + :model model + :model-capabilities + (assoc model-capabilities :reason? false :tools false :web-search false) + :instructions (f.prompt/title-prompt) + :user-messages user-messages + :config config + :provider-auth provider-auth})] + (when output-text + (let [title (subs output-text 0 (min (count output-text) 30))] + (swap! db* assoc-in [:chats chat-id :title] title) + (send-content! chat-ctx :system (assoc-some {:type :metadata} :title title)) + (when (= :idle (get-in @db* [:chats chat-id :status])) + (db/update-workspaces-cache! @db* metrics))))))) + (send-content! chat-ctx :system {:type :progress :state :running :text "Waiting model"}) + (future* config + (llm-api/sync-or-async-prompt! + {:model model + :provider provider + :model-capabilities model-capabilities + :user-messages user-messages + :instructions instructions + :past-messages past-messages + :config config + :tools all-tools + :provider-auth provider-auth + :on-first-response-received (fn [& _] + (assert-chat-not-stopped! chat-ctx) + (doseq [message user-messages] + (add-to-history! + (assoc message :content-id (:user-content-id chat-ctx)))) + (send-content! chat-ctx :system {:type :progress + :state :running + :text "Generating"})) + :on-usage-updated on-usage-updated + :on-message-received (fn [{:keys [type] :as msg}] + (assert-chat-not-stopped! chat-ctx) + (case type + :text (do (swap! received-msgs* str (:text msg)) + (send-content! chat-ctx :assistant {:type :text :text (:text msg)})) + :url (send-content! chat-ctx :assistant {:type :url :title (:title msg) :url (:url msg)}) + :limit-reached (do (send-content! + chat-ctx + :system + {:type :text + :text (str "API limit reached. Tokens: " + (json/generate-string (:tokens msg)))}) + (finish-chat-prompt! :idle chat-ctx)) + :finish (do (add-to-history! {:role "assistant" + :content [{:type :text :text @received-msgs*}]}) + (finish-chat-prompt! :idle chat-ctx)))) + :on-prepare-tool-call (fn [{:keys [id full-name arguments-text]}] + (assert-chat-not-stopped! chat-ctx) + (let [tool (tool-by-full-name full-name all-tools)] + (transition-tool-call! db* chat-ctx id :tool-prepare + {:name (:name tool) + :server (:name (:server tool)) + :full-name full-name + :origin (:origin tool) + :arguments-text arguments-text + :summary (f.tools/tool-call-summary all-tools full-name nil config)}))) + :on-tools-called (on-tools-called! chat-ctx received-msgs* add-to-history!) + :on-reason (fn [{:keys [status id text external-id]}] + (assert-chat-not-stopped! chat-ctx) + (case status + :started (do (swap! reasonings* assoc-in [id :start-time] (System/currentTimeMillis)) + (send-content! chat-ctx :assistant {:type :reasonStarted :id id})) + :thinking (do (swap! reasonings* update-in [id :text] str text) + (send-content! chat-ctx :assistant {:type :reasonText :id id :text text})) + :finished (let [total-time-ms (- (System/currentTimeMillis) (get-in @reasonings* [id :start-time]))] + (add-to-history! {:role "reason" + :content {:id id + :external-id external-id + :total-time-ms total-time-ms + :text (get-in @reasonings* [id :text])}}) + (send-content! chat-ctx :assistant {:type :reasonFinished :total-time-ms total-time-ms :id id})) + nil)) + :on-error (fn [{:keys [message exception]}] + (send-content! chat-ctx :system {:type :text :text (or message (str "Error: " (ex-message exception)))}) + (finish-chat-prompt! :idle chat-ctx))})))))) (defn ^:private send-mcp-prompt! - [{:keys [prompt args]} + [{:keys [prompt args] :as _decision} {:keys [db*] :as chat-ctx}] (let [{:keys [arguments]} (first (filter #(= prompt (:name %)) (f.mcp/all-prompts @db*))) args-vals (zipmap (map :name arguments) args) {:keys [messages error-message]} (f.prompt/get-prompt! prompt args-vals @db*)] (if error-message - (send-content! chat-ctx :system + (send-content! chat-ctx + :system {:type :text :text error-message}) - (prompt-messages! messages chat-ctx)))) + (prompt-messages! messages :mcp-prompt chat-ctx)))) (defn ^:private message-content->chat-content [role message-content content-id] (case role @@ -956,11 +1234,16 @@ :title title))))) (finish-chat-prompt! :idle chat-ctx)) :new-chat-status (finish-chat-prompt! (:status result) chat-ctx) - :send-prompt (prompt-messages! [{:role "user" - :content (:prompt result)}] - (assoc chat-ctx :on-finished-side-effect on-finished-side-effect)) + :send-prompt (let [prompt-contents (:prompt result)] + ;; Keep original slash command in :message for hooks (already in parent chat-ctx) + (prompt-messages! [{:role "user" :content prompt-contents}] + :eca-command + (assoc chat-ctx :on-finished-side-effect on-finished-side-effect))) nil))) +;; preRequest hook handling moved into prompt-messages! +;; This helper removed. Logic centralized for all prompt types. + (defn prompt [{:keys [message model behavior contexts chat-id]} db* @@ -968,10 +1251,42 @@ config metrics] (let [message (string/trim message) + provided-chat-id chat-id chat-id (or chat-id (let [new-id (str (random-uuid))] (swap! db* assoc-in [:chats new-id] {:id new-id}) new-id)) + ;; Snapshot DB to detect new/resumed chat BEFORE hooks mutate it + [db0 _] (swap-vals! db* assoc-in [:chat-start-fired chat-id] true) + existing-chat-before-prompt (get-in db0 [:chats chat-id]) + chat-start-fired? (get-in db0 [:chat-start-fired chat-id]) + has-messages? (seq (:messages existing-chat-before-prompt)) + resumed? (boolean (and (not chat-start-fired?) + provided-chat-id + has-messages?)) + ;; Trigger chatStart hook as early as possible so its additionalContext + ;; is visible in build-chat-instructions and /prompt-show. + _ (when-not chat-start-fired? + (let [hook-results* (atom []) + hook-ctx {:messenger messenger :chat-id chat-id}] + (f.hooks/trigger-if-matches! :chatStart + (merge (f.hooks/base-hook-data db0) + {:chat-id chat-id + :resumed resumed?}) + {:on-before-action (partial notify-before-hook-action! hook-ctx) + :on-after-action (fn [result] + (notify-after-hook-action! hook-ctx result) + (swap! hook-results* conj result))} + db0 + config) + ;; Collect additionalContext from all chatStart hooks and store + ;; it as startup-context for this chat. + (when-let [additional-contexts (seq (keep #(get-in % [:parsed :additionalContext]) @hook-results*))] + (swap! db* assoc-in [:chats chat-id :startup-context] + (string/join "\n\n" additional-contexts))) + ;; Mark chatStart as fired for this chat in this server run + (swap! db* assoc-in [:chat-start-fired chat-id] true))) + ;; Re-read DB after potential chatStart modifications db @db* raw-behavior (or behavior (-> config :chat :defaultBehavior) ;; legacy @@ -996,12 +1311,13 @@ repo-map* selected-behavior config + chat-id db) image-contents (->> refined-contexts (filter #(= :image (:type %)))) expanded-prompt-contexts (when-let [contexts-str (some-> (f.context/contexts-str-from-prompt message db) seq - (f.prompt/contexts-str repo-map*))] + (f.prompt/contexts-str repo-map* nil))] [{:type :text :text contexts-str}]) user-messages [{:role "user" :content (vec (concat [{:type :text :text message}] expanded-prompt-contexts @@ -1019,30 +1335,15 @@ :config config :user-content-id (new-content-id) :messenger messenger} - decision (message->decision message db config) - hook-outputs* (atom []) - _ (f.hooks/trigger-if-matches! :preRequest - {:chat-id chat-id - :prompt message} - {:on-before-action (partial notify-before-hook-action! chat-ctx) - :on-after-action (fn [result] - (when (and (= 0 (:status result)) - (:output result)) - (swap! hook-outputs* conj (:output result))) - (notify-after-hook-action! chat-ctx result))} - db - config) - user-messages (if (seq @hook-outputs*) - (update-in user-messages [0 :content 0 :text] #(str % " " (string/join "\n" @hook-outputs*))) - user-messages)] - (swap! db* assoc-in [:chats chat-id :status] :running) + decision (message->decision message db config)] + ;; Show original prompt to user, but LLM receives the modified version (send-content! chat-ctx :user {:type :text :content-id (:user-content-id chat-ctx) :text (str message "\n")}) (case (:type decision) :mcp-prompt (send-mcp-prompt! decision chat-ctx) :eca-command (handle-command! decision chat-ctx) - :prompt-message (prompt-messages! user-messages chat-ctx)) + :prompt-message (prompt-messages! user-messages :prompt-message chat-ctx)) (metrics/count-up! "prompt-received" {:full-model full-model :behavior behavior} @@ -1119,8 +1420,20 @@ (finish-chat-prompt! :stopping chat-ctx)))) (defn delete-chat - [{:keys [chat-id]} db* metrics] + [{:keys [chat-id]} db* config metrics] + (when-let [chat (get-in @db* [:chats chat-id])] + ;; Trigger chatEnd hook BEFORE deleting (chat still exists in cache) + (f.hooks/trigger-if-matches! :chatEnd + (merge (f.hooks/base-hook-data @db*) + {:chat-id chat-id + :title (:title chat) + :message-count (count (:messages chat))}) + {} + @db* + config)) + ;; Delete chat from memory (swap! db* update :chats dissoc chat-id) + ;; Save updated cache (without this chat) (db/update-workspaces-cache! @db* metrics)) (defn rollback-chat diff --git a/src/eca/features/hooks.clj b/src/eca/features/hooks.clj index 362ea29c..ee93bfa4 100644 --- a/src/eca/features/hooks.clj +++ b/src/eca/features/hooks.clj @@ -1,76 +1,177 @@ (ns eca.features.hooks (:require + [babashka.fs :as fs] [babashka.process :as p] [cheshire.core :as json] [eca.logger :as logger] - [eca.shared :as shared])) + [eca.shared :as shared] + [eca.features.tools.shell :as f.tools.shell])) (def ^:private logger-tag "[HOOK]") -(defn ^:private hook-matches? [type data hook] +(def ^:const hook-rejection-exit-code 2) + +(def ^:const default-hook-timeout-ms 30000) + +(defn base-hook-data + "Returns common fields for ALL hooks (session and chat hooks). + These fields are present in every hook type." + [db] + {:workspaces (shared/get-workspaces db) + :db-cache-path (shared/db-cache-path db)}) + +(defn chat-hook-data + "Returns common fields for CHAT-RELATED hooks. + Includes base fields plus chat-specific fields (chat-id, behavior). + Use this for: preRequest, postRequest, preToolCall, postToolCall, chatStart, chatEnd." + [db chat-id behavior] + (merge (base-hook-data db) + {:chat-id chat-id + :behavior behavior})) + +(defn ^:private parse-hook-json + "Attempts to parse hook output as JSON. Returns parsed map if successful, nil otherwise." + [output] + (when (and output (not-empty output)) + (try + (let [parsed (json/parse-string output true)] + (if (map? parsed) + parsed + (logger/debug logger-tag "Hook JSON output must result in map"))) + (catch Exception e + (logger/debug logger-tag "Hook output is not valid JSON, treating as plain text" + {:output output :error (.getMessage e)}) + nil)))) + +(defn run-shell-cmd [opts] + (try + (let [timeout-ms (or (:timeout opts) default-hook-timeout-ms) + proc (f.tools.shell/start-shell-process! opts) + result (deref proc timeout-ms ::timeout)] + (if (= result ::timeout) + (do + (logger/warn logger-tag "Hook timed out" {:timeout-ms timeout-ms}) + (p/destroy-tree proc) + {:exit 1 :out nil :err (format "Hook timed out after %d seconds" (/ timeout-ms 1000))}) + {:exit (:exit result) + :out (:out result) + :err (:err result)})) + (catch Exception e + (let [msg (or (.getMessage e) "Caught an Exception during execution of hook")] + (logger/warn logger-tag "Got an Exception during execution" {:message msg}) + {:exit 1 :err msg})))) + +(defn ^:private should-skip-on-error? + "Check if postToolCall hook should be skipped when tool errors. + By default, postToolCall hooks only run on success unless runOnError is true." + [type hook data] + (and (= type :postToolCall) + (not (get hook :runOnError false)) + (:error data))) + +(defn ^:private hook-matches? [hook-type data hook] (let [hook-config-type (keyword (:type hook)) hook-config-type (cond ;; legacy values (= :prePrompt hook-config-type) :preRequest (= :postPrompt hook-config-type) :postRequest :else hook-config-type)] (cond - (not= type hook-config-type) + (not= hook-type hook-config-type) false - (contains? #{:preToolCall :postToolCall} type) + (should-skip-on-error? hook-type hook data) + false + + (contains? #{:preToolCall :postToolCall} hook-type) (re-matches (re-pattern (or (:matcher hook) ".*")) (str (:server data) "__" (:tool-name data))) :else true))) -(defn ^:private run-hook-action! [action name data db] +(defn ^:private run-and-parse-output! + "Run shell command and return parsed result map." + [opts] + (let [{:keys [exit out err]} (run-shell-cmd opts) + raw-output (not-empty out) + raw-error (not-empty err)] + {:exit exit + :raw-output raw-output + :raw-error raw-error + :parsed (parse-hook-json raw-output)})) + +(defn run-hook-action! + "Execute a single hook action. Supported hook types: + - :sessionStart, :sessionEnd (session lifecycle) + - :chatStart, :chatEnd (chat lifecycle) + - :preRequest, :postRequest (prompt lifecycle) + - :preToolCall, :postToolCall (tool lifecycle) + + Returns map with :exit, :raw-output, :raw-error, :parsed" + [action name hook-type data db] (case (:type action) "shell" (let [cwd (some-> (:workspace-folders db) first :uri shared/uri->filename) shell (:shell action) - input (json/generate-string (merge {:hook-name name} data))] - (logger/info logger-tag (format "Running hook '%s' shell '%s' with input '%s'" name shell input)) - (let [{:keys [exit out err]} (p/sh {:dir cwd} - "bash" "-c" shell "--" input)] - [exit (not-empty out) (not-empty err)])) - (logger/warn logger-tag (format "Unknown hook action %s for %s" (:type action) name)))) + file (:file action) + ;; Convert to snake_case for bash/shell conventions + ;; Nested keys (e.g. tool_input/tool_response): kebab-case (matches LLM format) + input (json/generate-string (shared/map->snake-cased-map + (merge {:hook-name name :hook-type hook-type} data)))] + (cond + (and shell file) + (logger/error logger-tag (format "Hook '%s' has both 'shell' and 'file' - must have exactly one" name)) + + (and (not shell) (not file)) + (logger/error logger-tag (format "Hook '%s' missing both 'shell' and 'file' - must have one" name)) + + (nil? cwd) + (logger/error logger-tag (format "Hook '%s' cannot run: no workspace folders configured" name)) + + shell + (do (logger/debug logger-tag (format "Running hook '%s' inline shell '%s' with input '%s'" name shell input)) + (run-and-parse-output! {:cwd cwd :input input :script shell :timeout (:timeout action)})) + + file + (do (logger/debug logger-tag (format "Running hook '%s' file '%s' with input '%s'" name file input)) + (run-and-parse-output! {:cwd cwd :input input :file (str (fs/expand-home file)) :timeout (:timeout action)})))) + + (logger/warn logger-tag (format "Unknown hook action type '%s' for %s" (:type action) name)))) (defn trigger-if-matches! "Run hook of specified type if matches any config for that type" - [type + [hook-type data {:keys [on-before-action on-after-action] :or {on-before-action identity on-after-action identity}} db config] - (doseq [[name hook] (:hooks config)] - (when (hook-matches? type data hook) + ;; Sort hooks by name to ensure deterministic execution order. + (doseq [[name hook] (sort-by key (:hooks config))] + (when (hook-matches? hook-type data hook) (vec (map-indexed (fn [i action] (let [id (str (random-uuid)) - type (:type action) - name (if (> 1 (count (:actions hook))) + action-type (:type action) + name (if (> (count (:actions hook)) 1) (str name "-" (inc i)) name) visible? (get hook :visible true)] (on-before-action {:id id :visible? visible? :name name}) - (if-let [[status output error] (run-hook-action! action name data db)] - (on-after-action {:id id - :name name - :type type - :visible? visible? - :status status - :output output - :error error}) + (if-let [result (run-hook-action! action name hook-type data db)] + (on-after-action (merge result + {:id id + :name name + :type action-type + :visible? visible?})) (on-after-action {:id id :name name :visible? visible? - :type type - :status -1})))) + :type action-type + :exit 1})))) (:actions hook)))))) diff --git a/src/eca/features/prompt.clj b/src/eca/features/prompt.clj index 6edc83df..53561012 100644 --- a/src/eca/features/prompt.clj +++ b/src/eca/features/prompt.clj @@ -59,7 +59,7 @@ :else (load-builtin-prompt "agent_behavior.md")))) -(defn contexts-str [refined-contexts repo-map*] +(defn contexts-str [refined-contexts repo-map* startup-ctx] (multi-str "" "" @@ -86,9 +86,12 @@ ""))) "" refined-contexts) + ;; TODO - should be refined contexts? + (when startup-ctx + (str "\n\n" startup-ctx "\n\n\n")) "")) -(defn build-chat-instructions [refined-contexts rules repo-map* behavior config db] +(defn build-chat-instructions [refined-contexts rules repo-map* behavior config chat-id db] (multi-str (eca-chat-prompt behavior config) (when (seq rules) @@ -105,7 +108,7 @@ (when (seq refined-contexts) ["## Contexts" "" - (contexts-str refined-contexts repo-map*)]) + (contexts-str refined-contexts repo-map* (get-in db [:chats chat-id :startup-context]))]) "" (replace-vars (load-builtin-prompt "additional_system_info.md") diff --git a/src/eca/features/tools/shell.clj b/src/eca/features/tools/shell.clj index 257d987d..d0002ae6 100644 --- a/src/eca/features/tools/shell.clj +++ b/src/eca/features/tools/shell.clj @@ -15,6 +15,40 @@ (def ^:private default-timeout 60000) (def ^:private max-timeout (* 60000 10)) +(defn start-shell-process! + "Start a shell process, returning the process object for deref/management. + + Options: + - :cwd Working directory (required) + - :script Inline script string (mutually exclusive with :file) + - :file Script file path (mutually exclusive with :script) + - :input String to pass as stdin (optional) + + Returns: babashka.process process object (deref-able)" + [{:keys [cwd script file input]}] + {:pre [(some? cwd) + (or (some? script) (some? file)) + (not (and script file))]} + (let [win? (string/starts-with? (System/getProperty "os.name") "Windows") + cmd (cond + (and win? file) + ["powershell.exe" "-ExecutionPolicy" "Bypass" "-File" file] + + (and win? script) + ["powershell.exe" "-NoProfile" "-Command" script] + + file + ["bash" file] + + :else + ["bash" "-c" script])] + (p/process (cond-> {:cmd cmd + :dir cwd + :out :string + :err :string + :continue true} + input (assoc :in input))))) + (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") @@ -30,11 +64,8 @@ _ (logger/debug logger-tag "Running command:" command-args) result (try (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))] + (start-shell-process! {:cwd work-dir + :script command-args}))] (do (state-transition-fn :resources-created {:resources {:process proc}}) (try (deref proc diff --git a/src/eca/handlers.clj b/src/eca/handlers.clj index 40d23e48..8e2d831b 100644 --- a/src/eca/handlers.clj +++ b/src/eca/handlers.clj @@ -4,6 +4,7 @@ [eca.db :as db] [eca.features.chat :as f.chat] [eca.features.completion :as f.completion] + [eca.features.hooks :as f.hooks] [eca.features.login :as f.login] [eca.features.rewrite :as f.rewrite] [eca.features.tools :as f.tools] @@ -73,10 +74,27 @@ error)}})) (config/listen-for-changes! db*)) (future - (f.tools/init-servers! db* messenger config metrics))) - -(defn shutdown [{:keys [db* metrics]}] + (f.tools/init-servers! db* messenger config metrics)) + ;; Trigger sessionStart hook after initialization + (f.hooks/trigger-if-matches! :sessionStart + (f.hooks/base-hook-data @db*) + {} + @db* + config)) + +(defn shutdown [{:keys [db* config metrics]}] (metrics/task metrics :eca/shutdown + ;; 1. Save cache BEFORE hook so db-cache-path contains current state + (db/update-workspaces-cache! @db* metrics) + + ;; 2. Trigger sessionEnd hook + (f.hooks/trigger-if-matches! :sessionEnd + (f.hooks/base-hook-data @db*) + {} + @db* + config) + + ;; 3. Then shutdown (f.mcp/shutdown! db*) (swap! db* assoc :stopping true) nil)) @@ -111,9 +129,9 @@ (metrics/task metrics :eca/chat-prompt-stop (f.chat/prompt-stop params db* messenger metrics))) -(defn chat-delete [{:keys [db* metrics]} params] +(defn chat-delete [{:keys [db* config metrics]} params] (metrics/task metrics :eca/chat-delete - (f.chat/delete-chat params db* metrics) + (f.chat/delete-chat params db* config metrics) {})) (defn chat-rollback [{:keys [db* metrics messenger]} params] diff --git a/src/eca/shared.clj b/src/eca/shared.clj index b4b3f03b..11f4f4b2 100644 --- a/src/eca/shared.clj +++ b/src/eca/shared.clj @@ -4,7 +4,8 @@ [clojure.core.memoize :as memoize] [clojure.java.io :as io] [clojure.string :as string] - [clojure.walk :as walk]) + [clojure.walk :as walk] + [eca.cache :as cache]) (:import [java.net URI] [java.nio.file Paths] @@ -143,6 +144,12 @@ x)) m))) +(defn map->snake-cased-map + "Converts top-level keyword keys to snake_case strings. + Used for hook script inputs to follow shell/bash conventions." + [m] + (update-keys m #(if (keyword %) (csk/->snake_case %) %))) + (defn obfuscate "Obfuscate all but first `preserve-num` and last `preserve-num` characters of a string. If the string is 4 characters or less, obfuscate all characters. @@ -214,3 +221,16 @@ (deliver p# e#)))))] (.start t#) p#))) + +(defn get-workspaces + "Returns a vector of all workspace folder paths. + Returns nil if no workspace folders are configured." + [db] + (when-let [folders (seq (:workspace-folders db))] + (mapv (comp uri->filename :uri) folders))) + +(defn db-cache-path + "Returns the absolute path to the workspace-specific DB cache file as a string. + Used by hooks to access the cached database." + [db] + (str (cache/workspace-cache-file (:workspace-folders db) "db.transit.json" uri->filename))) diff --git a/test/eca/features/chat_test.clj b/test/eca/features/chat_test.clj index 7e721674..1ff4a4b6 100644 --- a/test/eca/features/chat_test.clj +++ b/test/eca/features/chat_test.clj @@ -3,6 +3,7 @@ [clojure.string :as string] [clojure.test :refer [deftest is testing]] [eca.features.chat :as f.chat] + [eca.features.hooks :as f.hooks] [eca.features.prompt :as f.prompt] [eca.features.tools :as f.tools] [eca.features.tools.mcp :as f.mcp] @@ -487,14 +488,15 @@ f.prompt/get-prompt! (fn [_ args-map _] (reset! prompt-args args-map) {:messages [{:role :user :content "test"}]}) - f.chat/prompt-messages! (fn [messages ctx] (reset! invoked? [messages ctx]))] + f.chat/prompt-messages! (fn [messages source-type ctx] + (reset! invoked? [messages source-type ctx]))] (#'f.chat/send-mcp-prompt! {:prompt "awesome-prompt" :args [42 "yo"]} test-chat-ctx) (is (match? @prompt-args {"foo" 42 "bar" "yo"})) (is (match? @invoked? - [[{:role :user :content "test"}] test-chat-ctx])))))) + [[{:role :user :content "test"}] :mcp-prompt test-chat-ctx])))))) (deftest message->decision-test (testing "plain prompt message" @@ -602,3 +604,169 @@ :content {:type :text :text "\n2"} :role "assistant"}]} (h/messages))))))) + +(deftest decide-tool-call-action-test + (testing "config-based approval - allow" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config) + behavior :default + chat-id "test-chat"] + (with-redefs [f.tools/approval (constantly :allow) + f.hooks/trigger-if-matches! (fn [_ _ _ _ _] nil)] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (match? {:decision :allow + :arguments {:foo "bar"} + :approval-override nil + :hook-rejected? false + :arguments-modified? false + :reason {:code :user-config-allow + :text string?}} + plan)))))) + + (testing "config-based approval - ask" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config) + behavior :default + chat-id "test-chat"] + (with-redefs [f.tools/approval (constantly :ask) + f.hooks/trigger-if-matches! (fn [_ _ _ _ _] nil)] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (match? {:decision :ask + :arguments {:foo "bar"} + :approval-override nil + :hook-rejected? false + :arguments-modified? false} + plan)))))) + + (testing "config-based approval - deny" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config) + behavior :default + chat-id "test-chat"] + (with-redefs [f.tools/approval (constantly :deny) + f.hooks/trigger-if-matches! (fn [_ _ _ _ _] nil)] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (match? {:decision :deny + :arguments {:foo "bar"} + :approval-override nil + :hook-rejected? false + :arguments-modified? false + :reason {:code :user-config-deny + :text string?}} + plan)))))) + + (testing "hook approval override - allow to ask" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config! {:hooks {"hook1" {:event "preToolCall" + :actions [{:type "shell" :command "echo 'approval override'"}]}}}) + behavior :default + chat-id "test-chat" + hook-call-count (atom 0)] + (with-redefs [f.tools/approval (constantly :allow) + f.hooks/trigger-if-matches! (fn [event _ callbacks _ _] + (when (= event :preToolCall) + (swap! hook-call-count inc) + (when-let [on-after (:on-after-action callbacks)] + (on-after {:parsed {:approval "ask"} + :exit 0}))))] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (= 1 @hook-call-count)) + (is (match? {:decision :ask + :arguments {:foo "bar"} + :approval-override "ask" + :hook-rejected? false + :arguments-modified? false} + plan)))))) + + (testing "hook rejection via exit code 2" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config! {:hooks {"hook1" {:event "preToolCall" + :actions [{:type "shell" :command "exit 2"}]}}}) + behavior :default + chat-id "test-chat"] + (with-redefs [f.tools/approval (constantly :allow) + f.hooks/trigger-if-matches! (fn [event _ callbacks _ _] + (when (= event :preToolCall) + (when-let [on-after (:on-after-action callbacks)] + (on-after {:parsed {:additionalContext "Hook rejected"} + :exit 2 + :raw-error "Command failed"}))))] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (match? {:decision :deny + :arguments {:foo "bar"} + :approval-override nil + :hook-rejected? true + :arguments-modified? false + :reason {:code :hook-rejected + :text "Hook rejected"} + :hook-continue true + :hook-stop-reason nil} + plan)))))) + + (testing "hook modifies arguments" + (h/reset-components!) + (let [tool-call {:id "call-1" + :full-name "eca__test_tool" + :arguments {:foo "bar"}} + all-tools [{:name "test_tool" + :full-name "eca__test_tool" + :origin :eca + :server {:name "eca"}}] + db (h/db) + config (h/config! {:hooks {"hook1" {:event "preToolCall" + :actions [{:type "shell" :command "echo 'modify args'"}]}}}) + behavior :default + chat-id "test-chat"] + (with-redefs [f.tools/approval (constantly :allow) + f.hooks/trigger-if-matches! (fn [event _ callbacks _ _] + (when (= event :preToolCall) + (when-let [on-after (:on-after-action callbacks)] + (on-after {:parsed {:updatedInput {:baz "qux"}} + :exit 0}))))] + (let [plan (#'f.chat/decide-tool-call-action tool-call all-tools db config behavior chat-id)] + (is (match? {:decision :allow + :arguments {:foo "bar" :baz "qux"} + :approval-override nil + :hook-rejected? false + :arguments-modified? true} + plan))))))) diff --git a/test/eca/features/chat_tool_call_state_test.clj b/test/eca/features/chat_tool_call_state_test.clj index 4e310b2e..de9022dd 100644 --- a/test/eca/features/chat_tool_call_state_test.clj +++ b/test/eca/features/chat_tool_call_state_test.clj @@ -472,7 +472,7 @@ result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-end result-data)] (is (match? {:status :cleanup - :actions [:deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} + :actions [:save-execution-result :deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} result) "Expected transition to :cleanup with send toolCalled and record metrics actions") @@ -543,7 +543,7 @@ "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 :cleanup - :actions [:deliver-future-cleanup-completed :send-toolCallRejected]} + :actions [:save-execution-result :deliver-future-cleanup-completed :send-toolCallRejected]} result) "Expected transition from :stopping to :cleanup with relevant actions")))) @@ -830,7 +830,7 @@ "Expected promise to be delivered with true value")))))) (deftest transition-tool-call-stop-during-execution-test - ;; Test stopping a tool call during execution + ;; Test stopping a tool call during execution (testing ":executing -> :stopping -> :cleanup transition" (h/reset-components!) (let [db* (h/db*) @@ -907,7 +907,7 @@ result (#'f.chat/transition-tool-call! db* chat-ctx tool-call-id :execution-end error-result)] (is (match? {:status :cleanup - :actions [:deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} + :actions [:save-execution-result :deliver-future-cleanup-completed :send-toolCalled :log-metrics :send-progress]} result) "Expected transition to :cleanup with send toolCalled and record metrics actions") diff --git a/test/eca/features/hooks_test.clj b/test/eca/features/hooks_test.clj index b3427f31..89022588 100644 --- a/test/eca/features/hooks_test.clj +++ b/test/eca/features/hooks_test.clj @@ -1,6 +1,6 @@ (ns eca.features.hooks-test (:require - [babashka.process :as p] + [cheshire.core :as json] [clojure.test :refer [deftest is testing]] [eca.features.hooks :as f.hooks] [eca.test-helper :as h] @@ -12,72 +12,17 @@ (fn [p] (reset! a* p))) +;;; Basic trigger and matching tests + (deftest trigger-if-matches!-test - (testing "legacy prePrompt" - (h/reset-components!) - (h/config! {:hooks {"my-hook" {:type "prePrompt" - :actions [{:type "shell" - :shell "echo hey"}]}}}) - (let [on-before-action* (atom nil) - on-after-action* (atom nil)] - (with-redefs [p/sh (constantly {:exit 0 :out "hey" :err nil})] - (f.hooks/trigger-if-matches! - :preRequest - {:foo "1"} - {:on-before-action (set-action-payload on-before-action*) - :on-after-action (set-action-payload on-after-action*)} - (h/db) - (h/config))) - (is (match? - {:id string? - :visible? true - :name "my-hook"} - @on-before-action*)) - (is (match? - {:id string? - :name "my-hook" - :visible? true - :status 0 - :output "hey" - :error nil} - @on-after-action*)))) - (testing "preRequest" - (h/reset-components!) - (h/config! {:hooks {"my-hook" {:type "preRequest" - :actions [{:type "shell" - :shell "echo hey"}]}}}) - (let [on-before-action* (atom nil) - on-after-action* (atom nil)] - (with-redefs [p/sh (constantly {:exit 0 :out "hey" :err nil})] - (f.hooks/trigger-if-matches! - :preRequest - {:foo "1"} - {:on-before-action (set-action-payload on-before-action*) - :on-after-action (set-action-payload on-after-action*)} - (h/db) - (h/config))) - (is (match? - {:id string? - :visible? true - :name "my-hook"} - @on-before-action*)) - (is (match? - {:id string? - :name "my-hook" - :visible? true - :status 0 - :output "hey" - :error nil} - @on-after-action*)))) - (testing "when visible is false" + (testing "preRequest hook triggers and provides callbacks" (h/reset-components!) (h/config! {:hooks {"my-hook" {:type "preRequest" - :visible false :actions [{:type "shell" :shell "echo hey"}]}}}) (let [on-before-action* (atom nil) on-after-action* (atom nil)] - (with-redefs [p/sh (constantly {:exit 0 :out "hey" :err nil})] + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 :out "hey" :err nil})] (f.hooks/trigger-if-matches! :preRequest {:foo "1"} @@ -85,69 +30,232 @@ :on-after-action (set-action-payload on-after-action*)} (h/db) (h/config))) - (is (match? - {:id string? - :visible? false - :name "my-hook"} - @on-before-action*)) - (is (match? - {:id string? - :name "my-hook" - :visible? false - :status 0 - :output "hey" - :error nil} - @on-after-action*)))) - (testing "preToolCall does not matches" + (is (match? {:name "my-hook" :visible? true} @on-before-action*)) + (is (match? {:name "my-hook" :exit 0 :raw-output "hey"} @on-after-action*)))) + + (testing "preToolCall matcher filters correctly" (h/reset-components!) (h/config! {:hooks {"my-hook" {:type "preToolCall" :matcher "my-mcp__my.*" - :actions [{:type "shell" - :shell "echo hey"}]}}}) - (let [on-before-action* (atom nil) - on-after-action* (atom nil)] - (with-redefs [p/sh (constantly {:exit 2 :out nil :err "stop!"})] - (f.hooks/trigger-if-matches! - :preToolCall - {:server "my-other-mcp" - :tool-name "my-tool"} - {:on-before-action (set-action-payload on-before-action*) - :on-after-action (set-action-payload on-after-action*)} - (h/db) - (h/config))) - (is (match? - nil - @on-before-action*)) - (is (match? - nil - @on-after-action*)))) - (testing "preToolCall matches" + :actions [{:type "shell" :shell "echo hey"}]}}}) + (let [result* (atom nil)] + ;; Should NOT match + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 :out "hey" :err nil})] + (f.hooks/trigger-if-matches! :preToolCall + {:server "other-mcp" :tool-name "my-tool"} + {:on-after-action (set-action-payload result*)} + (h/db) (h/config))) + (is (nil? @result*)) + + ;; Should match + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 :out "hey" :err nil})] + (f.hooks/trigger-if-matches! :preToolCall + {:server "my-mcp" :tool-name "my-tool"} + {:on-after-action (set-action-payload result*)} + (h/db) (h/config))) + (is (match? {:name "my-hook"} @result*))))) + +;;; JSON parsing tests + +(deftest json-output-parsing-test + (testing "valid JSON output is parsed" (h/reset-components!) - (h/config! {:hooks {"my-hook" {:type "preToolCall" - :matcher "my-mcp__my.*" - :actions [{:type "shell" - :shell "echo hey"}]}}}) - (let [on-before-action* (atom nil) - on-after-action* (atom nil)] - (with-redefs [p/sh (constantly {:exit 2 :out nil :err "stop!"})] - (f.hooks/trigger-if-matches! - :preToolCall - {:server "my-mcp" - :tool-name "my-tool"} - {:on-before-action (set-action-payload on-before-action*) - :on-after-action (set-action-payload on-after-action*)} - (h/db) - (h/config))) - (is (match? - {:id string? - :visible? true - :name "my-hook"} - @on-before-action*)) - (is (match? - {:id string? - :name "my-hook" - :visible? true - :status 2 - :output nil - :error "stop!"} - @on-after-action*))))) + (h/config! {:hooks {"test" {:type "preRequest" + :actions [{:type "shell" + :shell "echo '{\"additionalContext\":\"test\"}'"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 + :out "{\"additionalContext\":\"test\"}" + :err nil})] + (f.hooks/trigger-if-matches! :preRequest {:foo "1"} + {:on-after-action (set-action-payload result*)} + (h/db) (h/config))) + (is (= "test" (get-in @result* [:parsed :additionalContext]))))) + + (testing "invalid JSON falls back to plain text" + (h/reset-components!) + (h/config! {:hooks {"test" {:type "preRequest" + :actions [{:type "shell" :shell "echo 'plain'"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 :out "plain" :err nil})] + (f.hooks/trigger-if-matches! :preRequest {:foo "1"} + {:on-after-action (set-action-payload result*)} + (h/db) (h/config))) + (is (nil? (:parsed @result*))) + (is (= "plain" (:raw-output @result*)))))) + +;;; New features tests + +(deftest tool-input-and-tool-response-test + (testing "preToolCall uses tool_input (renamed from arguments)" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"chat-1" {:behavior "agent"}}) + (h/config! {:hooks {"test" {:type "preToolCall" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :preToolCall + (merge (f.hooks/chat-hook-data (h/db) "chat-1" "agent") + {:tool-name "read_file" + :server "eca" + :tool-input {:path "/foo"} + :approval :ask}) + {} (h/db) (h/config))) + (is (= {:path "/foo"} (:tool_input @result*))) + (is (not (contains? @result* :arguments))))) + + (testing "postToolCall receives tool_input and tool_response" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"chat-1" {:behavior "agent"}}) + (h/config! {:hooks {"test" {:type "postToolCall" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :postToolCall + (merge (f.hooks/chat-hook-data (h/db) "chat-1" "agent") + {:tool-name "read_file" + :server "eca" + :tool-input {:path "/foo"} + :tool-response {:content "data"}}) + {} (h/db) (h/config))) + (is (= {:path "/foo"} (:tool_input @result*))) + (is (= {:content "data"} (:tool_response @result*)))))) + +(deftest stop-hook-active-test + (testing "postRequest receives stop_hook_active flag" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"chat-1" {:behavior "agent"}}) + (h/config! {:hooks {"test" {:type "postRequest" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :postRequest + (merge (f.hooks/chat-hook-data (h/db) "chat-1" "agent") + {:prompt "test" + :stop-hook-active false}) + {} (h/db) (h/config))) + (is (false? (:stop_hook_active @result*)))))) + +(deftest approval-field-test + (testing "preToolCall can return approval in JSON output" + (h/reset-components!) + (h/config! {:hooks {"test" {:type "preToolCall" + :actions [{:type "shell" + :shell "echo '{\"approval\":\"deny\",\"additionalContext\":\"Too large\"}'"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (constantly {:exit 0 + :out "{\"approval\":\"deny\",\"additionalContext\":\"Too large\"}" + :err nil})] + (f.hooks/trigger-if-matches! :preToolCall + {:server "eca" :tool-name "read"} + {:on-after-action (set-action-payload result*)} + (h/db) (h/config))) + (is (= "deny" (get-in @result* [:parsed :approval]))) + (is (= "Too large" (get-in @result* [:parsed :additionalContext])))))) + +;;; Lifecycle hooks tests + +(deftest session-hooks-test + (testing "sessionStart has base fields only" + (h/reset-components!) + (h/config! {:hooks {"test" {:type "sessionStart" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :sessionStart + (f.hooks/base-hook-data (h/db)) + {} (h/db) (h/config))) + (is (contains? @result* :workspaces)) + (is (contains? @result* :db_cache_path)) + (is (not (contains? @result* :chat_id))) + (is (not (contains? @result* :behavior))))) + + (testing "sessionEnd has active-chats-count but NOT session_end field" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"c1" {} "c2" {}}) + (h/config! {:hooks {"test" {:type "sessionEnd" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :sessionEnd + (merge (f.hooks/base-hook-data (h/db)) + {:active-chats-count 2}) + {} (h/db) (h/config))) + (is (= 2 (:active_chats_count @result*))) + (is (not (contains? @result* :session_end)))))) + +(deftest chat-hooks-test + (testing "chatStart with resumed flag" + (h/reset-components!) + (h/config! {:hooks {"test" {:type "chatStart" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :chatStart + (merge (f.hooks/base-hook-data (h/db)) + {:chat-id "new-chat" + :resumed false}) + {} (h/db) (h/config))) + (is (= "new-chat" (:chat_id @result*))) + (is (false? (:resumed @result*))))) + + (testing "chatEnd with metadata but NOT session_end field" + (h/reset-components!) + (h/config! {:hooks {"test" {:type "chatEnd" + :actions [{:type "shell" :shell "cat"}]}}}) + (let [result* (atom nil)] + (with-redefs [f.hooks/run-shell-cmd (fn [opts] + (reset! result* (json/parse-string (:input opts) true)) + {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :chatEnd + (merge (f.hooks/base-hook-data (h/db)) + {:chat-id "chat-1" + :title "Test" + :message-count 10}) + {} (h/db) (h/config))) + (is (= "chat-1" (:chat_id @result*))) + (is (= "Test" (:title @result*))) + (is (= 10 (:message_count @result*))) + (is (not (contains? @result* :session_end)))))) + +;;; postToolCall runOnError tests + +(deftest posttoolcall-runonerror-test + (testing "runOnError=false (default) skips hook on error" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"chat-1" {:behavior "agent"}}) + (h/config! {:hooks {"test" {:type "postToolCall" + :actions [{:type "shell" :shell "echo test"}]}}}) + (let [ran?* (atom false)] + (with-redefs [f.hooks/run-shell-cmd (fn [_] (reset! ran?* true) {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :postToolCall + (merge (f.hooks/chat-hook-data (h/db) "chat-1" "agent") + {:tool-name "tool" :server "eca" :error true}) + {} (h/db) (h/config))) + (is (false? @ran?*)))) + + (testing "runOnError=true runs hook on error" + (h/reset-components!) + (swap! (h/db*) assoc :chats {"chat-1" {:behavior "agent"}}) + (h/config! {:hooks {"test" {:type "postToolCall" + :runOnError true + :actions [{:type "shell" :shell "echo test"}]}}}) + (let [ran?* (atom false)] + (with-redefs [f.hooks/run-shell-cmd (fn [_] (reset! ran?* true) {:exit 0 :out "" :err nil})] + (f.hooks/trigger-if-matches! :postToolCall + (merge (f.hooks/chat-hook-data (h/db) "chat-1" "agent") + {:tool-name "tool" :server "eca" :error true}) + {} (h/db) (h/config))) + (is (true? @ran?*))))) diff --git a/test/eca/features/prompt_test.clj b/test/eca/features/prompt_test.clj index 80a36c3d..7d1341ca 100644 --- a/test/eca/features/prompt_test.clj +++ b/test/eca/features/prompt_test.clj @@ -16,7 +16,7 @@ fake-repo-map (delay "TREE") behavior "agent" config {} - result (prompt/build-chat-instructions refined-contexts rules fake-repo-map behavior config (h/db))] + result (prompt/build-chat-instructions refined-contexts rules fake-repo-map behavior config nil (h/db))] (is (string/includes? result "You are ECA")) (is (string/includes? result "")) (is (string/includes? result "First rule")) @@ -38,15 +38,15 @@ fake-repo-map (delay "TREE") behavior "plan" config {} - result (prompt/build-chat-instructions refined-contexts rules fake-repo-map behavior config (h/db))] + result (prompt/build-chat-instructions refined-contexts rules fake-repo-map behavior config nil (h/db))] (is (string/includes? result "You are ECA")) (is (string/includes? result "")) (is (string/includes? result "First rule")) (is (string/includes? result "Second rule")) - (is (string/includes? result "")) - (is (string/includes? result "(ns foo)")) - (is (string/includes? result "(def a 1)")) - (is (string/includes? result "TREE")) - (is (string/includes? result "some-cool-content")) - (is (string/includes? result "")) - (is (string? result))))) + (is (string/includes? result "")) + (is (string/includes? result "(ns foo)")) + (is (string/includes? result "(def a 1)")) + (is (string/includes? result "TREE")) + (is (string/includes? result "some-cool-content")) + (is (string/includes? result "")) + (is (string? result))))) diff --git a/test/eca/test_helper.clj b/test/eca/test_helper.clj index 880a2c57..0cb1be60 100644 --- a/test/eca/test_helper.clj +++ b/test/eca/test_helper.clj @@ -60,7 +60,10 @@ (defn reset-components! [] (reset! config/initialization-config* {}) - (reset! components* (make-components))) + (reset! components* (make-components)) + ;; Set default workspace folder for tests + (swap! (db*) assoc :workspace-folders [{:uri (shared/filename->uri (System/getProperty "user.dir"))}])) + (defn reset-components-before-test [] (use-fixtures :each (fn [f] (reset-components!) (f)))) (defn reset-messenger! [] (swap! components* assoc :messenger (:messenger (make-components))))