Cleanup chats after 7days to avoid huge files

Author: ericdallo

CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## Unreleased
 
+- Delete chats older than 7 days on server startup.
+- Use human-readable workspace cache directory names (e.g. `my-project_a1b2c3d4`), with automatic migration from old hash-only format.
+
 ## 0.113.1
 
 - Fix MCP server threads blocking ECA shutdown when stuck during initialization; startup now uses daemon threads with interrupt-based cancellation for clean exit.

src/eca/cache.clj

@@ -32,14 +32,51 @@
         key (.encodeToString encoder digest)]
     (subs key 0 (min 8 (count key)))))
 
+(def ^:private logger-tag "[CACHE]")
+
+(def ^:private max-prefix-length 30)
+
+(defn ^:private workspace-dir-name
+  "Returns a human-readable directory name for the workspace cache.
+   Format: <sanitized-project-name>_<hash>, or just <hash> if no name is available."
+  [workspaces uri->filename-fn]
+  (let [hash (workspaces-hash workspaces uri->filename-fn)
+        first-uri (some-> workspaces first :uri)
+        project-name (when first-uri
+                       (some-> (uri->filename-fn first-uri)
+                               fs/file-name
+                               str
+                               not-empty))
+        sanitized (when project-name
+                    (let [s (string/replace project-name #"[^a-zA-Z0-9._-]" "_")]
+                      (subs s 0 (min max-prefix-length (count s)))))]
+    (if (not-empty sanitized)
+      (str sanitized "_" hash)
+      hash)))
+
+(defn ^:private migrate-workspace-cache-dir!
+  "Migrates old hash-only workspace cache directory to new human-readable format."
+  [^File old-dir ^File new-dir]
+  (try
+    (fs/move old-dir new-dir)
+    (logger/info logger-tag (str "Migrated workspace cache from " old-dir " to " new-dir))
+    (catch Exception e
+      (logger/warn logger-tag "Failed to migrate workspace cache directory:" (.getMessage e)))))
+
 (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))
+  (let [dir-name (workspace-dir-name workspaces uri->filename-fn)
+        hash-only (workspaces-hash workspaces uri->filename-fn)
+        base (global-dir)
+        new-dir (io/file base dir-name)
+        old-dir (io/file base hash-only)]
+    (when (and (not= dir-name hash-only)
+               (not (fs/exists? new-dir))
+               (fs/exists? old-dir))
+      (migrate-workspace-cache-dir! old-dir new-dir))
+    (io/file new-dir filename)))
 
-(def ^:private logger-tag "[CACHE]")
 (def ^:private tool-call-outputs-dir-name "toolCallOutputs")
 (def ^:private plugins-dir-name "plugins")
 

src/eca/db.clj

@@ -205,3 +205,23 @@
   (-> (normalize-db-for-global-write db)
       (assoc :version version)
       (upsert-cache! (transit-global-db-file) metrics)))
+
+(def ^:private seven-days-ms (* 7 24 60 60 1000))
+
+(defn cleanup-old-chats!
+  "Deletes chats older than 7 days from the db and flushes the workspace cache."
+  [db* metrics]
+  (let [cutoff (- (System/currentTimeMillis) seven-days-ms)
+        removed (atom 0)]
+    (swap! db* update :chats
+           (fn [chats]
+             (into {}
+                   (filter (fn [[_id chat]]
+                             (let [created-at (:created-at chat)]
+                               (if (and created-at (< created-at cutoff))
+                                 (do (swap! removed inc) false)
+                                 true))))
+                   chats)))
+    (when (pos? @removed)
+      (logger/info logger-tag (str "Cleaned up " @removed " chat(s) older than 7 days"))
+      (update-workspaces-cache! @db* metrics))))

src/eca/handlers.clj

@@ -115,7 +115,8 @@
     (let [config (config/all @db*)]
       (f.tools/init-servers! db* messenger config metrics)))
   (future
-    (cache/cleanup-tool-call-outputs!))
+    (cache/cleanup-tool-call-outputs!)
+    (db/cleanup-old-chats! db* metrics))
   ;; Trigger sessionStart hook after initialization
   (shared/future* config
     (f.hooks/trigger-if-matches! :sessionStart

test/eca/cache_test.clj

@@ -46,3 +46,65 @@
         (is (string? path))
         (is (fs/exists? path))
         (is (= text (slurp path)))))))
+
+(deftest workspace-dir-name-test
+  (let [dir-name #'cache/workspace-dir-name]
+    (testing "prefixes hash with project name from first workspace URI"
+      (let [workspaces [{:uri "file:///home/user/my-project"}]
+            result (dir-name workspaces identity)]
+        (is (re-matches #"my-project_.{8}" result))))
+
+    (testing "sanitizes unsafe filesystem characters"
+      (let [workspaces [{:uri "file:///home/user/my project@v2!"}]
+            result (dir-name workspaces identity)]
+        (is (re-matches #"my_project_v2__.{8}" result))
+        (is (nil? (re-find #"[ @!]" result)))))
+
+    (testing "truncates long project names to 30 chars"
+      (let [long-name (apply str (repeat 50 "a"))
+            workspaces [{:uri (str "file:///home/user/" long-name)}]
+            result (dir-name workspaces identity)]
+        (is (<= (count result) (+ 30 1 8)))))
+
+    (testing "falls back to hash-only when no workspace name available"
+      (let [result (dir-name [] identity)]
+        (is (re-matches #".{8}" result))))
+
+    (testing "uses first workspace name when multiple workspaces"
+      (let [workspaces [{:uri "file:///home/user/first-project"}
+                        {:uri "file:///home/user/second-project"}]
+            result (dir-name workspaces identity)]
+        (is (re-matches #"first-project_.{8}" result))))))
+
+(deftest workspace-cache-file-migration-test
+  (testing "migrates old hash-only directory to new format"
+    (with-temp-cache-dir
+      (let [workspaces [{:uri "file:///home/user/my-project"}]
+            hash-only (cache/workspaces-hash workspaces identity)
+            old-dir (io/file (cache/global-dir) hash-only)]
+        ;; Create old-format directory with a cache file
+        (fs/create-dirs old-dir)
+        (spit (io/file old-dir "db.transit.json") "{}")
+
+        (let [result (cache/workspace-cache-file workspaces "db.transit.json" identity)]
+          (is (not (fs/exists? old-dir)) "Old directory should be renamed")
+          (is (fs/exists? (.getParentFile result)) "New directory should exist")
+          (is (= "{}" (slurp result)) "Migrated file content should be preserved")
+          (is (re-find #"my-project_" (str result)) "New path should contain project name")))))
+
+  (testing "does not migrate when new directory already exists"
+    (with-temp-cache-dir
+      (let [workspaces [{:uri "file:///home/user/my-project"}]
+            hash-only (cache/workspaces-hash workspaces identity)
+            old-dir (io/file (cache/global-dir) hash-only)
+            result-before (cache/workspace-cache-file workspaces "db.transit.json" identity)
+            new-dir (.getParentFile result-before)]
+        ;; Create both directories
+        (fs/create-dirs old-dir)
+        (spit (io/file old-dir "db.transit.json") "old")
+        (fs/create-dirs new-dir)
+        (spit (io/file new-dir "db.transit.json") "new")
+
+        (let [result (cache/workspace-cache-file workspaces "db.transit.json" identity)]
+          (is (fs/exists? old-dir) "Old directory should remain untouched")
+          (is (= "new" (slurp result)) "Should use new directory content"))))))

test/eca/db_test.clj

@@ -0,0 +1,44 @@
+(ns eca.db-test
+  (:require
+   [clojure.test :refer [deftest is testing]]
+   [eca.db :as db]))
+
+(set! *warn-on-reflection* true)
+
+(deftest cleanup-old-chats-test
+  (let [now (System/currentTimeMillis)
+        eight-days-ago (- now (* 8 24 60 60 1000))
+        two-days-ago (- now (* 2 24 60 60 1000))
+        db* (atom {:chats {"old-chat" {:id "old-chat"
+                                       :created-at eight-days-ago
+                                       :messages [{:role "user" :content "hi"}]}
+                           "recent-chat" {:id "recent-chat"
+                                          :created-at two-days-ago
+                                          :messages [{:role "user" :content "hello"}]}
+                           "no-timestamp" {:id "no-timestamp"
+                                           :messages [{:role "user" :content "hey"}]}}
+                   :workspace-folders []})]
+    (testing "deletes old chats, keeps recent and chats without created-at"
+      (with-redefs [db/update-workspaces-cache! (fn [_ _])]
+        (db/cleanup-old-chats! db* nil))
+      (is (nil? (get-in @db* [:chats "old-chat"]))
+          "Chat older than 7 days should be removed")
+      (is (some? (get-in @db* [:chats "recent-chat"]))
+          "Chat newer than 7 days should be kept")
+      (is (some? (get-in @db* [:chats "no-timestamp"]))
+          "Chat without created-at should be kept"))))
+
+(deftest cleanup-old-chats-no-op-test
+  (let [now (System/currentTimeMillis)
+        two-days-ago (- now (* 2 24 60 60 1000))
+        db* (atom {:chats {"recent" {:id "recent"
+                                     :created-at two-days-ago
+                                     :messages [{:role "user" :content "hi"}]}}
+                   :workspace-folders []})
+        cache-updated? (atom false)]
+    (testing "does not flush cache when nothing to clean"
+      (with-redefs [db/update-workspaces-cache! (fn [_ _] (reset! cache-updated? true))]
+        (db/cleanup-old-chats! db* nil))
+      (is (some? (get-in @db* [:chats "recent"])))
+      (is (false? @cache-updated?)
+          "Should not flush cache when no chats were removed"))))