|
67 | 67 | (when (not-empty agent) (str "/" agent)))) |
68 | 68 |
|
69 | 69 | (defn ^:private static-prompt-cache-signature |
70 | | - "SHA-256 cache identity for static prompt reuse." |
| 70 | + "Per-component SHA-256 cache identity for static prompt reuse. |
| 71 | + Returns a map of category -> hash so mid-chat instruction changes |
| 72 | + can be attributed to what changed (prompt, contexts, rules, skills, tools)." |
71 | 73 | [refined-contexts static-rules path-scoped-rules skills agent config chat-id all-tools db] |
72 | | - (let [static-contexts (vec (filter f.prompt/static-prompt-context? refined-contexts))] |
73 | | - (digest/sha-256-hex |
74 | | - (pr-str |
75 | | - {:agent agent |
76 | | - :chat-prompt-template (f.prompt/eca-chat-prompt agent config chat-id db) |
77 | | - :workspace-roots (mapv (comp shared/uri->filename :uri) (:workspace-folders db)) |
78 | | - :environment {:os-name (str (System/getProperty "os.name") " " (System/getProperty "os.version")) |
79 | | - :shell (or (System/getenv "SHELL") (System/getenv "ComSpec")) |
80 | | - :user-name (System/getProperty "user.name") |
81 | | - :home-dir (cache/user-home)} |
82 | | - :is-subagent (boolean (get-in db [:chats chat-id :subagent])) |
83 | | - :startup-context (get-in db [:chats chat-id :startup-context]) |
84 | | - :static-contexts static-contexts |
85 | | - :repo-map (when (some #(= :repoMap (:type %)) static-contexts) |
86 | | - :present) |
87 | | - :static-rules (mapv #(select-keys % [:id :name :scope :content]) static-rules) |
88 | | - :path-scoped-rules (mapv #(select-keys % [:id :name :scope :workspace-root :paths :enforce]) path-scoped-rules) |
89 | | - :skills (mapv #(select-keys % [:name :description]) skills) |
90 | | - :tools (sort (map :full-name all-tools))})))) |
| 74 | + (let [static-contexts (vec (filter f.prompt/static-prompt-context? refined-contexts)) |
| 75 | + sha (comp digest/sha-256-hex pr-str)] |
| 76 | + {:prompt (sha {:agent agent |
| 77 | + :chat-prompt-template (f.prompt/eca-chat-prompt agent config chat-id db) |
| 78 | + :environment {:os-name (str (System/getProperty "os.name") " " (System/getProperty "os.version")) |
| 79 | + :shell (or (System/getenv "SHELL") (System/getenv "ComSpec")) |
| 80 | + :user-name (System/getProperty "user.name") |
| 81 | + :home-dir (cache/user-home)} |
| 82 | + :is-subagent (boolean (get-in db [:chats chat-id :subagent])) |
| 83 | + :startup-context (get-in db [:chats chat-id :startup-context])}) |
| 84 | + :contexts (sha {:workspace-roots (mapv (comp shared/uri->filename :uri) (:workspace-folders db)) |
| 85 | + :static-contexts static-contexts |
| 86 | + :repo-map (when (some #(= :repoMap (:type %)) static-contexts) |
| 87 | + :present)}) |
| 88 | + :rules (sha {:static-rules (mapv #(select-keys % [:id :name :scope :content]) static-rules) |
| 89 | + :path-scoped-rules (mapv #(select-keys % [:id :name :scope :workspace-root :paths :enforce]) path-scoped-rules)}) |
| 90 | + :skills (sha (mapv #(select-keys % [:name :description]) skills)) |
| 91 | + :tools (sha (sort (map :full-name all-tools)))})) |
| 92 | + |
| 93 | +(defn ^:private changed-instruction-categories |
| 94 | + "Names of instruction categories that changed vs the cached signature. |
| 95 | + Empty when the old signature has an unknown (legacy) shape." |
| 96 | + [prompt-cache static-signature agent full-model] |
| 97 | + (let [old-sig (:static-signature prompt-cache)] |
| 98 | + (cond-> [] |
| 99 | + (not= (:agent prompt-cache) agent) (conj "agent") |
| 100 | + (not= (:model prompt-cache) full-model) (conj "model") |
| 101 | + (map? old-sig) (into (keep (fn [[k v]] |
| 102 | + (when (not= v (get old-sig k)) |
| 103 | + (name k))) |
| 104 | + static-signature))))) |
91 | 105 |
|
92 | 106 | (defn ^:private prune-tool-results! |
93 | 107 | "Prunes old tool result content from chat history to reduce context size. |
|
1491 | 1505 | (let [result (f.prompt/build-chat-instructions |
1492 | 1506 | refined-contexts static-rules path-scoped-rules skills repo-map* |
1493 | 1507 | agent config chat-id all-tools db)] |
| 1508 | + (when prompt-cache |
| 1509 | + (let [categories (changed-instruction-categories prompt-cache static-signature agent full-model)] |
| 1510 | + (lifecycle/send-content! |
| 1511 | + base-chat-ctx :system |
| 1512 | + {:type :text |
| 1513 | + :text (str "Instructions changed" |
| 1514 | + (when (seq categories) |
| 1515 | + (str " (" (string/join ", " categories) ")")) |
| 1516 | + ", prompt cache invalidated.\n")}))) |
1494 | 1517 | (swap! db* assoc-in [:chats chat-id :prompt-cache] |
1495 | 1518 | {:static (:static result) |
1496 | 1519 | :static-signature static-signature |
|
0 commit comments