From db38db3f63810d4bf4d9ad734b94787fea2f0e8d Mon Sep 17 00:00:00 2001 From: Laurens Van Houtven Date: Wed, 14 Oct 2026 15:12:51 -0500 Subject: [PATCH 1/3] Add opt-in background refresh before cache expiry --- README.md | 36 +++ src/com/latacora/sqlite_cache/core.clj | 136 ++++----- .../latacora/sqlite_cache/refresh_test.clj | 277 ++++++++++++++++++ 3 files changed, 381 insertions(+), 68 deletions(-) create mode 100644 test/com/latacora/sqlite_cache/refresh_test.clj diff --git a/README.md b/README.md index 642fec7..0fa2d08 100644 --- a/README.md +++ b/README.md @@ -92,6 +92,42 @@ creates them before opening SQLite. New filesystem databases on POSIX systems are created with mode `0600`; existing files keep their permissions. SQLite URI paths (`file:...`) and in-memory databases are passed through unchanged. +### Background refresh + +Set `:refresh-after` to return a cached value immediately while refreshing it +in the background on a read: + +```clojure +(cache/cache + {:db {:dbtype "sqlite" :dbname "api-cache.db"} + :func expensive-api-call + :func-name "api-call" + :max-age (* 30 60) + :refresh-after 60}) +``` + +This starts a refresh on the first read at or after one minute. To leave time +for computation before expiry, use `:refresh-after {:before-max-age 120}`; +with a thirty-minute `:max-age`, this starts refreshing at twenty-eight minutes. +Both forms use seconds and must resolve to an age above zero and below +`:max-age`. The convenience form is resolved when constructing the cache. + +Reads before the refresh threshold return the cached value. Reads at or after +the threshold return it and start or join one background computation per key +within the process. Missing entries and entries at or beyond their stored +`:max-age` wait for that same computation. Refreshes run on Clojure's future +pool; database writes continue through the SQLite writer queue. Refreshes are +triggered by reads, so an idle entry may expire before a refresh starts. + +A successful refresh replaces the value and resets its age when stored. +A failed refresh logs a warning, retains the previous value until its original +expiry, and allows a later read to retry. Blocking computation failures still +throw to the caller. TTL remains an idle eviction policy. + +Omitting `:refresh-after` (or setting it to `nil`) preserves blocking refresh +on expiry. Existing database files need no migration; persisted entries retain +their stored TTL and max-age until replaced. + ### Supported types The cache uses [transit-canon](https://github.com/latacora/transit-canon) for serialization, so out of the box it supports: diff --git a/src/com/latacora/sqlite_cache/core.clj b/src/com/latacora/sqlite_cache/core.clj index d1300fd..3f872d2 100644 --- a/src/com/latacora/sqlite_cache/core.clj +++ b/src/com/latacora/sqlite_cache/core.clj @@ -24,7 +24,8 @@ [com.latacora.sqlite-cache.maintenance :as maint]) (:import (java.nio.file FileAlreadyExistsException) - (java.util.concurrent LinkedBlockingQueue TimeUnit))) + (java.util.concurrent LinkedBlockingQueue TimeUnit) + (java.util.logging Logger Level))) ;; This currently does not use clojure.core.cache, but it probably could stand ;; to be compatible with it. The problem with clojure.core.cache is that it's @@ -61,55 +62,22 @@ ;; ... and hence all entries would be cold. (defn ^:private get! - "Gets a value from the cache based on the provided options and cache arguments. - - Options should include: - - conn: The database connection - - func-name: The function name for which the cache is being checked - - Returns the cached value if found and not stale, or nil otherwise." - [opts cache-args] - ;; This function has to deal with a subtle concurrency problem. Originally, - ;; the attempt to get a cache entry and the hit counter increment happened - ;; inside of a transaction. If two threads try to get something form the - ;; cache and both hit, they'll both try to increment the hit count - ;; almost simultaneously. This results in an upgraded transaction: - ;; - ;; 1. Thread A starts transaction A, performs a SELECT, acquiring read lock - ;; 2. Thread B starts transaction B, performs a SELECT, acquiring read lock) - ;; 3. Thread A gets a hit, runs an UPDATE, acquiring intent-to-write-lock - ;; 4. Thread B gets a hit, runs an UPDATE, *fails to acquire the lock* - ;; - ;; Step 4 always fails because SQLite knows that A can't complete: it would - ;; need an exclusive lock to commit to the database, but it can't get it - ;; because B has the intent-to-write lock. This can't be solved by adding a - ;; busy handler to wait, because it's a deadlock: B also can't complete - ;; because A also has an intent-to-write lock preventing B from acquiring an - ;; exclusive lock. - ;; - ;; There are a few ways to solve this. One is to tell SQLite that all of these - ;; transactions require IMMEDIATE. That reduces reader concurrency to 1. - ;; Another is to do the cache hit outside of the transaction (because the - ;; first statement in the hit process is an UPDATE, SQLite knows it needs a - ;; write lock). We could even have a different thread worry about updating the - ;; hit counter: it's not critical for correctness, just an approximate - ;; statistical measure. - ;; - ;; For now, we're assuming that hit updates won't block for long enough to - ;; warrant shunting them off to a separate thread for processing, and that - ;; hits can be done out-of-transaction and still be almost always correct: - ;; close enough for this purpose. - (let [{:keys [read-conn func-name handlers]} opts - q (-> (h/select :id :result) + "Returns an entry with its value and refresh status, or nil when missing or stale." + [{:keys [read-conn func-name handlers refresh-after]} cache-args] + (let [refresh? (if refresh-after + (maint/in-the-past [:+ :created-at refresh-after]) + [:inline 0]) + q (-> (h/select :id :result [refresh? :refresh?]) (h/from :cache) (h/where [:= :function func-name] [:= :args cache-args] [:not maint/stale?])) - {:keys [id result]} (db/exec-one! read-conn q)] + {:keys [id result refresh?]} (db/exec-one! read-conn q)] (when id - (queue-write! (assoc opts :op-fn hit! :entry-id id)) - (ser/deserialize result {:handlers (:read handlers)})))) + {:id id + :value (ser/deserialize result {:handlers (:read handlers)}) + :refresh? (pos? refresh?)}))) (defn ^:private hit! "Updates hit count and last-hit time for a cache entry." @@ -178,32 +146,61 @@ (fn [_k _atom old new] (println "put-queue changed from" old "to" new)))) +(defn- computation! + [{:keys [func db] :as opts} cache-args serialized-args args] + (let [queue-key [db func cache-args] + computation + (delay + (try + ;; A refresh may have been stored since the caller read the old entry. + (let [entry (get! opts serialized-args)] + (if (and entry (not (:refresh? entry))) + (do + (swap! put-queue dissoc queue-key) + (:value entry)) + (let [result (apply func args)] + (queue-write! (assoc opts :op-fn put! :serialized-args serialized-args + :result result :queue-key queue-key)) + result))) + (catch Throwable e + (swap! put-queue dissoc queue-key) + (throw e)))) + [before after] (swap-vals! put-queue update queue-key #(or % computation))] + [(get after queue-key) (not (contains? before queue-key))])) + (defn ^:private cached - [{:keys [func args-cache-key db handlers] :as opts} & args] + [{:keys [args-cache-key handlers func-name] :as opts} & args] (let [cache-args (args-cache-key args) serialized-args (ser/serialize cache-args {:handlers (:write handlers)})] - (or - (get! opts serialized-args) - ;; Prevent more than 1 thread from trying to compute the same thing at once. - (let [queue-key [db func cache-args]] - (-> - (swap! - put-queue update queue-key - (fn [maybe-delay] - (or - maybe-delay ;; Another thread is already working on this. - (delay - (try - (let [result (apply func args)] - ;; Asynchronously write to cache, return immediately, rely on put-queue delay for other, simultaneous requests of the same data - (queue-write! (assoc opts :op-fn put! :serialized-args serialized-args :result result :queue-key queue-key)) - result) - (catch Exception e - ;; Clear put-queue entry on error so future calls can retry - (swap! put-queue dissoc queue-key) - (throw e))))))) - (get queue-key) - (deref)))))) + (if-let [{:keys [id value refresh?]} (get! opts serialized-args)] + (do + (queue-write! (assoc opts :op-fn hit! :entry-id id)) + (when refresh? + (let [[computation new?] (computation! opts cache-args serialized-args args)] + (when new? + (future + (try + @computation + (catch Throwable e + (.log (Logger/getLogger "com.latacora.sqlite-cache") Level/WARNING + (str "Background refresh failed for " func-name) e))))))) + value) + (let [[computation _] (computation! opts cache-args serialized-args args)] + @computation)))) + +(defn- normalize-refresh-after + [{:keys [refresh-after max-age] :as opts}] + (if (nil? refresh-after) + opts + (let [before? (and (map? refresh-after) + (= #{:before-max-age} (set (keys refresh-after)))) + duration (if before? (:before-max-age refresh-after) refresh-after) + valid-duration? (and (number? duration) (number? max-age) + (< 0 duration max-age))] + (when-not valid-duration? + (throw (ex-info ":refresh-after must be positive seconds below :max-age, or {:before-max-age seconds}" + {:refresh-after refresh-after :max-age max-age}))) + (assoc opts :refresh-after (if before? (- max-age duration) duration))))) (def default-opts "Default options for the cache function. @@ -248,6 +245,9 @@ - func-name: The function name for identification in the cache - ttl: Time to live in seconds - max-age: Maximum age in seconds + - refresh-after: Optional age in seconds at which a hit starts a background + refresh, or {:before-max-age seconds}. Must resolve to an age above zero + and below max-age. Missing or expired entries wait for the same computation. - args-cache-key: Function to transform arguments into cache key - handlers: Optional extra transit handlers for types not covered by the built-in defaults (which already include `java.time.*`, @@ -261,7 +261,7 @@ canonical handlers (map/set sorting, Long->BigInt) always win — those are required for cache-key correctness." [opts] - (let [{:keys [db] :as opts} (merge default-opts opts) + (let [{:keys [db] :as opts} (normalize-refresh-after (merge default-opts opts)) _ (prepare-db-file! db) read-conn (jdbc/get-connection db) write-conn (jdbc/get-connection db) diff --git a/test/com/latacora/sqlite_cache/refresh_test.clj b/test/com/latacora/sqlite_cache/refresh_test.clj new file mode 100644 index 0000000..bd94cd8 --- /dev/null +++ b/test/com/latacora/sqlite_cache/refresh_test.clj @@ -0,0 +1,277 @@ +(ns com.latacora.sqlite-cache.refresh-test + (:require + [clojure.test :as t] + [com.latacora.sqlite-cache.core :as c] + [com.latacora.sqlite-cache.test-utils :as tu] + [next.jdbc :as jdbc]) + (:import (java.util.concurrent LinkedBlockingQueue ExecutionException))) + +(defn- await! [pending] + (let [pending (if (delay? pending) (future @pending) pending)] + (try + (let [result (deref pending 5000 ::timeout)] + (when (= ::timeout result) + (throw (ex-info "Timed out waiting for test computation" {}))) + result) + (catch ExecutionException e + (throw (.getCause e)))))) + +(defn- in-flight [cached-fn & args] + (let [{:keys [db func args-cache-key]} (meta cached-fn)] + (get @@#'c/put-queue [db func (args-cache-key args)]))) + +(t/deftest refresh-option-validation-test + (doseq [option [0 -1 10 11 "5" false {} {:before-max-age 0} + {:before-max-age -1} {:before-max-age 10} + {:before-max-age "2"} {:before-max-age 2 :extra true} + Double/NaN Double/POSITIVE_INFINITY]] + (with-redefs [jdbc/get-connection (fn [_] (throw (AssertionError. "Opened database before validation")))] + (t/is (thrown? clojure.lang.ExceptionInfo + (c/cache {:max-age 10 :refresh-after option})))))) + +(t/deftest refresh-boundaries-and-expired-join-test + (doseq [refresh-after [5 {:before-max-age 5}]] + (let [calls (atom 0) + started (promise) + release (promise)] + (tu/with-harness + {:auto-sync false + :cache-opts {:max-age 10 :refresh-after refresh-after} + :f (fn [& _] + (let [n (swap! calls inc)] + (when (= n 2) + (deliver started true) + (await! release)) + n))} + (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] + (let [cached base-cached-fn + waiter (atom nil)] + (try + (t/is (= 1 (cached :key))) + (sync-write-queue!) + (advance-clock! 4) + (t/is (= 1 (cached :key))) + (t/is (= 1 @calls)) + (advance-clock! 1) + (t/is (= 1 (await! (future (cached :key)))) "threshold hit returns while refresh is blocked") + (await! started) + (let [readers (doall (repeatedly 10 #(future (cached :key))))] + (doseq [reader readers] (t/is (= 1 (await! reader))))) + (t/is (= 2 @calls) "one refresh per key") + (advance-clock! 5) + (reset! waiter (future (cached :key))) + (t/is (= ::waiting (deref @waiter 100 ::waiting)) "hard-expired hit waits") + (deliver release true) + (t/is (= 2 (await! @waiter))) + (sync-write-queue!) + (t/is (= 2 (cached :key))) + (t/is (= 2 @calls)) + (t/is (false? (:stale? (c/entry-status cached :key))) "replacement resets age") + (finally + (deliver release true) + (when @waiter (await! @waiter)) + (when-let [pending (in-flight cached :key)] (await! pending)) + (sync-write-queue!))))))))) + +(t/deftest refresh-failure-retains-value-and-retries-test + (let [calls (atom 0) + started (promise) + release (promise)] + (tu/with-harness + {:auto-sync false + :cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] + (let [n (swap! calls inc)] + (when (= n 2) + (deliver started true) + (await! release) + (throw (ex-info "Refresh failed" {}))) + n))} + (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] + (let [cached base-cached-fn] + (try + (t/is (= 1 (cached :key))) + (sync-write-queue!) + (let [created-at (:created-at (c/entry-status cached :key))] + (advance-clock! 5) + (t/is (= 1 (cached :key))) + (await! started) + (let [pending (in-flight cached :key)] + (deliver release true) + (t/is (thrown-with-msg? clojure.lang.ExceptionInfo #"Refresh failed" (await! pending)))) + (t/is (= created-at (:created-at (c/entry-status cached :key))) "failure does not extend age") + (advance-clock! 5) + (t/is (= 3 (cached :key)) "expired call retries instead of serving failed refresh") + (sync-write-queue!) + (t/is (= 3 @calls))) + (finally + (deliver release true) + (sync-write-queue!)))))))) + +(t/deftest falsey-values-are-cache-hits-test + (doseq [value [nil false]] + (tu/with-harness + {:f (constantly value)} + (fn [{:keys [cached-fn n-calls]}] + (t/is (= value (cached-fn :key))) + (t/is (= value (cached-fn :key))) + (t/is (= 1 @n-calls)))) + (let [started (promise) + release (promise) + calls (atom 0)] + (tu/with-harness + {:auto-sync false + :cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] + (when (= 2 (swap! calls inc)) + (deliver started true) + (await! release)) + value)} + (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] + (let [cached base-cached-fn] + (try + (t/is (= value (cached :key))) + (sync-write-queue!) + (advance-clock! 5) + (t/is (= value (await! (future (cached :key))))) + (await! started) + (let [pending (in-flight cached :key)] + (deliver release true) + (t/is (= value (await! pending)))) + (sync-write-queue!) + (t/is (= value (cached :key))) + (t/is (= 2 @calls)) + (finally + (deliver release true) + (when-let [pending (in-flight cached :key)] (await! pending)) + (sync-write-queue!))))))))) + +(t/deftest refresh-remains-shared-until-stored-test + (let [calls (atom 0) + writer-started (promise) + writer-release (promise) + refresh-started (promise) + refresh-release (promise)] + (tu/with-harness + {:auto-sync false + :cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] + (let [n (swap! calls inc)] + (when (= n 2) + (deliver refresh-started true) + (await! refresh-release)) + n))} + (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] + (let [cached base-cached-fn + queue (:write-queue (meta cached))] + (try + (t/is (= 1 (cached :key))) + (sync-write-queue!) + (.put ^LinkedBlockingQueue queue + {:op-fn (fn [_] (deliver writer-started true) (await! writer-release))}) + (await! writer-started) + (advance-clock! 5) + (t/is (= 1 (cached :key))) + (await! refresh-started) + (let [pending (in-flight cached :key)] + (deliver refresh-release true) + (t/is (= 2 (await! pending))) + (dotimes [_ 10] (t/is (= 1 (cached :key)))) + (t/is (identical? pending (in-flight cached :key))) + (advance-clock! 5) + (t/is (= 2 (cached :key)) "expired reads use computed result pending storage") + (t/is (= 2 @calls))) + (finally + (deliver refresh-release true) + (deliver writer-release true) + (when-let [pending (in-flight cached :key)] (await! pending)) + (sync-write-queue!)))))))) + +(t/deftest refresh-shares-transformed-keys-without-blocking-other-keys-test + (let [calls (atom {}) + started (promise) + release (promise)] + (tu/with-harness + {:auto-sync false + :cache-opts {:max-age 10 :refresh-after 5 :args-cache-key sort} + :f (fn [& args] + (let [key (sort args) + n (get (swap! calls update key (fnil inc 0)) key)] + (when (and (= key '(1 2)) (= n 2)) + (deliver started true) + (await! release)) + {:key key :generation n :print-length *print-length*}))} + (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] + (let [cached base-cached-fn] + (try + (t/is (= 1 (:generation (cached 1 2)))) + (sync-write-queue!) + (advance-clock! 5) + (binding [*print-length* 7] + (t/is (= 1 (:generation (cached 2 1))))) + (await! started) + (t/is (= 1 (:generation (cached 1 2)))) + (t/is (= 1 (:generation (await! (future (cached 3 4))))) "another key can compute during refresh") + (let [pending (in-flight cached 1 2)] + (t/is (identical? pending (in-flight cached 2 1))) + (deliver release true) + (t/is (= 7 (:print-length (await! pending))) "background refresh conveys caller bindings")) + (sync-write-queue!) + (t/is (= 2 (:generation (cached 2 1)))) + (t/is (= {'(1 2) 2 '(3 4) 1} @calls)) + (finally + (deliver release true) + (when-let [pending (in-flight cached 1 2)] (await! pending)) + (sync-write-queue!)))))))) + +(t/deftest existing-entries-can-opt-into-refresh-test + (let [calls (atom 0) + started (promise) + release (promise) + func (fn [& _] + (let [n (swap! calls inc)] + (when (= n 2) + (deliver started true) + (await! release)) + n))] + (tu/with-harness + {:f func :cache-opts {:max-age 10}} + (fn [{:keys [cached-fn base-cached-fn db advance-clock!]}] + (t/is (= 1 (cached-fn :key))) + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + (t/is (= 1 @calls) "omitting refresh-after preserves behavior") + (let [refreshing (c/cache {:db db + :func (:func (meta base-cached-fn)) + :func-name "my-func" + :max-age 10 + :refresh-after {:before-max-age 5}})] + (try + (t/is (= 1 (refreshing :key)) "reads the existing persisted entry") + (await! started) + (let [pending (in-flight refreshing :key)] + (deliver release true) + (t/is (= 2 (await! pending)))) + (tu/sync-write-queue! refreshing) + (t/is (= 2 (cached-fn :key)) "old wrapper sees the replacement") + (finally + (deliver release true) + (when-let [pending (in-flight refreshing :key)] (await! pending)) + (tu/sync-write-queue! refreshing)))))))) + +(t/deftest blocking-computation-failure-after-expiry-test + (let [fail? (atom false)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] + (if @fail? + (throw (ex-info "Upstream unavailable" {})) + :value))} + (fn [{:keys [cached-fn base-cached-fn advance-clock!]}] + (t/is (= :value (cached-fn :key))) + (reset! fail? true) + (advance-clock! 10) + (t/is (thrown-with-msg? clojure.lang.ExceptionInfo #"Upstream unavailable" (cached-fn :key))) + (t/is (:stale? (c/entry-status base-cached-fn :key))) + (reset! fail? false) + (t/is (= :value (cached-fn :key)) "failed computation can be retried"))))) From a00d596c65435841f05dacb8b37dc834ef697562 Mon Sep 17 00:00:00 2001 From: Laurens Van Houtven Date: Thu, 15 Oct 2026 07:52:05 -0500 Subject: [PATCH 2/3] Address refresh review and isolate named cache computations --- README.md | 48 +- src/com/latacora/sqlite_cache/core.clj | 52 ++- .../latacora/sqlite_cache/refresh_test.clj | 439 +++++++++--------- 3 files changed, 273 insertions(+), 266 deletions(-) diff --git a/README.md b/README.md index 0fa2d08..49232e8 100644 --- a/README.md +++ b/README.md @@ -94,39 +94,31 @@ URI paths (`file:...`) and in-memory databases are passed through unchanged. ### Background refresh -Set `:refresh-after` to return a cached value immediately while refreshing it -in the background on a read: +`:refresh-after` opts into read-triggered background refresh: ```clojure -(cache/cache - {:db {:dbtype "sqlite" :dbname "api-cache.db"} - :func expensive-api-call - :func-name "api-call" - :max-age (* 30 60) - :refresh-after 60}) +{:max-age (* 30 60) + :refresh-after 60} ; eligible for refresh after one minute + +{:max-age (* 30 60) + :refresh-after {:before-max-age 120}} ; eligible after twenty-eight minutes ``` -This starts a refresh on the first read at or after one minute. To leave time -for computation before expiry, use `:refresh-after {:before-max-age 120}`; -with a thirty-minute `:max-age`, this starts refreshing at twenty-eight minutes. Both forms use seconds and must resolve to an age above zero and below -`:max-age`. The convenience form is resolved when constructing the cache. - -Reads before the refresh threshold return the cached value. Reads at or after -the threshold return it and start or join one background computation per key -within the process. Missing entries and entries at or beyond their stored -`:max-age` wait for that same computation. Refreshes run on Clojure's future -pool; database writes continue through the SQLite writer queue. Refreshes are -triggered by reads, so an idle entry may expire before a refresh starts. - -A successful refresh replaces the value and resets its age when stored. -A failed refresh logs a warning, retains the previous value until its original -expiry, and allows a later read to retry. Blocking computation failures still -throw to the caller. TTL remains an idle eviction policy. - -Omitting `:refresh-after` (or setting it to `nil`) preserves blocking refresh -on expiry. Existing database files need no migration; persisted entries retain -their stored TTL and max-age until replaced. +`:max-age`. The map is normalized at cache construction. On a read: + +- Before `:refresh-after`, return the cached value. +- At or after `:refresh-after`, return it and start or join a background refresh. +- Missing or at/after the stored `:max-age`, wait for the shared computation. + +Refreshes run on Clojure's future pool and remain shared until stored. Success +resets the entry's age. Failure logs a warning and retains the old value until +its original expiry; later reads retry. Blocking failures propagate. + +Omitting `:refresh-after` or setting it to `nil` preserves existing behavior. +There is no timer: idle entries are not refreshed. TTL remains an idle eviction +policy. Existing databases need no migration; entries retain their stored TTL +and max-age until replaced. ### Supported types diff --git a/src/com/latacora/sqlite_cache/core.clj b/src/com/latacora/sqlite_cache/core.clj index 3f872d2..1663a5b 100644 --- a/src/com/latacora/sqlite_cache/core.clj +++ b/src/com/latacora/sqlite_cache/core.clj @@ -64,6 +64,34 @@ (defn ^:private get! "Returns an entry with its value and refresh status, or nil when missing or stale." [{:keys [read-conn func-name handlers refresh-after]} cache-args] + ;; This function has to deal with a subtle concurrency problem. Originally, + ;; the attempt to get a cache entry and the hit counter increment happened + ;; inside of a transaction. If two threads try to get something form the + ;; cache and both hit, they'll both try to increment the hit count + ;; almost simultaneously. This results in an upgraded transaction: + ;; + ;; 1. Thread A starts transaction A, performs a SELECT, acquiring read lock + ;; 2. Thread B starts transaction B, performs a SELECT, acquiring read lock) + ;; 3. Thread A gets a hit, runs an UPDATE, acquiring intent-to-write-lock + ;; 4. Thread B gets a hit, runs an UPDATE, *fails to acquire the lock* + ;; + ;; Step 4 always fails because SQLite knows that A can't complete: it would + ;; need an exclusive lock to commit to the database, but it can't get it + ;; because B has the intent-to-write lock. This can't be solved by adding a + ;; busy handler to wait, because it's a deadlock: B also can't complete + ;; because A also has an intent-to-write lock preventing B from acquiring an + ;; exclusive lock. + ;; + ;; There are a few ways to solve this. One is to tell SQLite that all of these + ;; transactions require IMMEDIATE. That reduces reader concurrency to 1. + ;; Another is to do the cache hit outside of the transaction (because the + ;; first statement in the hit process is an UPDATE, SQLite knows it needs a + ;; write lock). We could even have a different thread worry about updating the + ;; hit counter: it's not critical for correctness, just an approximate + ;; statistical measure. + ;; + ;; Hit updates are queued to the writer thread after lookup. Keeping writes + ;; out of the read transaction avoids the lock upgrade described above. (let [refresh? (if refresh-after (maint/in-the-past [:+ :created-at refresh-after]) [:inline 0]) @@ -111,7 +139,7 @@ (swap! put-queue dissoc queue-key))))) (def ^:private put-queue - "A queue map of `[db func args]` to a delay that will compute the result, put it + "A queue map of `[db func-name func args]` to a delay that will compute the result, put it in the cache, and remove itself from this queue. This is used to prevent more than one thread from trying to compute the same @@ -147,8 +175,8 @@ (println "put-queue changed from" old "to" new)))) (defn- computation! - [{:keys [func db] :as opts} cache-args serialized-args args] - (let [queue-key [db func cache-args] + [{:keys [func func-name db] :as opts} cache-args serialized-args args] + (let [queue-key [db func-name func cache-args] computation (delay (try @@ -189,18 +217,12 @@ @computation)))) (defn- normalize-refresh-after - [{:keys [refresh-after max-age] :as opts}] - (if (nil? refresh-after) - opts - (let [before? (and (map? refresh-after) - (= #{:before-max-age} (set (keys refresh-after)))) - duration (if before? (:before-max-age refresh-after) refresh-after) - valid-duration? (and (number? duration) (number? max-age) - (< 0 duration max-age))] - (when-not valid-duration? - (throw (ex-info ":refresh-after must be positive seconds below :max-age, or {:before-max-age seconds}" - {:refresh-after refresh-after :max-age max-age}))) - (assoc opts :refresh-after (if before? (- max-age duration) duration))))) + [opts] + (update opts :refresh-after + (fn [refresh-after] + (if (map? refresh-after) + (- (:max-age opts) (:before-max-age refresh-after)) + refresh-after)))) (def default-opts "Default options for the cache function. diff --git a/test/com/latacora/sqlite_cache/refresh_test.clj b/test/com/latacora/sqlite_cache/refresh_test.clj index bd94cd8..fa9004b 100644 --- a/test/com/latacora/sqlite_cache/refresh_test.clj +++ b/test/com/latacora/sqlite_cache/refresh_test.clj @@ -2,276 +2,269 @@ (:require [clojure.test :as t] [com.latacora.sqlite-cache.core :as c] - [com.latacora.sqlite-cache.test-utils :as tu] - [next.jdbc :as jdbc]) - (:import (java.util.concurrent LinkedBlockingQueue ExecutionException))) + [com.latacora.sqlite-cache.test-utils :as tu]) + (:import (clojure.lang ExceptionInfo))) -(defn- await! [pending] - (let [pending (if (delay? pending) (future @pending) pending)] - (try - (let [result (deref pending 5000 ::timeout)] - (when (= ::timeout result) - (throw (ex-info "Timed out waiting for test computation" {}))) - result) - (catch ExecutionException e - (throw (.getCause e)))))) +(defn- with-refresh-jobs [test-fn] + (let [jobs (atom []) + run-next! (fn [] + (let [[before _] (swap-vals! jobs #(subvec % 1))] + @(first before)))] + (with-redefs [clojure.core/future-call + (fn [f] + (let [run (bound-fn [] (f)) + job (delay (run))] + (swap! jobs conj job) + job))] + (test-fn jobs run-next!)))) (defn- in-flight [cached-fn & args] - (let [{:keys [db func args-cache-key]} (meta cached-fn)] - (get @@#'c/put-queue [db func (args-cache-key args)]))) + (let [{:keys [db func-name func args-cache-key]} (meta cached-fn)] + (get @@#'c/put-queue [db func-name func (args-cache-key args)]))) -(t/deftest refresh-option-validation-test - (doseq [option [0 -1 10 11 "5" false {} {:before-max-age 0} - {:before-max-age -1} {:before-max-age 10} - {:before-max-age "2"} {:before-max-age 2 :extra true} - Double/NaN Double/POSITIVE_INFINITY]] - (with-redefs [jdbc/get-connection (fn [_] (throw (AssertionError. "Opened database before validation")))] - (t/is (thrown? clojure.lang.ExceptionInfo - (c/cache {:max-age 10 :refresh-after option})))))) +(t/deftest refresh-option-normalization-test + (doseq [[option expected] [[nil nil] [1 1] [9 9] + [{:before-max-age 1} 9] + [{:before-max-age 9} 1]]] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after option}} + (fn [{:keys [base-cached-fn]}] + (t/is (= expected (:refresh-after (meta base-cached-fn)))))))) -(t/deftest refresh-boundaries-and-expired-join-test +(t/deftest refresh-boundaries-test (doseq [refresh-after [5 {:before-max-age 5}]] - (let [calls (atom 0) - started (promise) - release (promise)] - (tu/with-harness - {:auto-sync false - :cache-opts {:max-age 10 :refresh-after refresh-after} - :f (fn [& _] - (let [n (swap! calls inc)] - (when (= n 2) - (deliver started true) - (await! release)) - n))} - (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] - (let [cached base-cached-fn - waiter (atom nil)] - (try - (t/is (= 1 (cached :key))) - (sync-write-queue!) + (with-refresh-jobs + (fn [jobs run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after refresh-after} + :f (fn [& _] (swap! calls inc))} + (fn [{:keys [cached-fn base-cached-fn advance-clock! sync-write-queue!]}] + (t/is (= 1 (cached-fn :key))) (advance-clock! 4) - (t/is (= 1 (cached :key))) - (t/is (= 1 @calls)) + (t/is (= 1 (cached-fn :key))) + (t/is (empty? @jobs)) (advance-clock! 1) - (t/is (= 1 (await! (future (cached :key)))) "threshold hit returns while refresh is blocked") - (await! started) - (let [readers (doall (repeatedly 10 #(future (cached :key))))] - (doseq [reader readers] (t/is (= 1 (await! reader))))) - (t/is (= 2 @calls) "one refresh per key") - (advance-clock! 5) - (reset! waiter (future (cached :key))) - (t/is (= ::waiting (deref @waiter 100 ::waiting)) "hard-expired hit waits") - (deliver release true) - (t/is (= 2 (await! @waiter))) + (t/is (= 1 (cached-fn :key))) + (dotimes [_ 10] (t/is (= 1 (cached-fn :key)))) + (t/is (= 1 @calls) "refresh is queued, not evaluated on the caller") + (t/is (= 1 (count @jobs)) "one background job per key") + (run-next!) (sync-write-queue!) - (t/is (= 2 (cached :key))) + (t/is (= 2 (cached-fn :key))) (t/is (= 2 @calls)) - (t/is (false? (:stale? (c/entry-status cached :key))) "replacement resets age") - (finally - (deliver release true) - (when @waiter (await! @waiter)) - (when-let [pending (in-flight cached :key)] (await! pending)) - (sync-write-queue!))))))))) + (t/is (false? (:stale? (c/entry-status base-cached-fn :key))))))))))) -(t/deftest refresh-failure-retains-value-and-retries-test +(t/deftest expired-read-evaluates-queued-refresh-test + (with-refresh-jobs + (fn [jobs run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] (swap! calls inc))} + (fn [{:keys [cached-fn advance-clock!]}] + (t/is (= 1 (cached-fn :key))) + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + (t/is (= 1 (count @jobs))) + (advance-clock! 5) + (t/is (= 2 (cached-fn :key)) "expired caller evaluates the queued shared delay") + (run-next!) + (t/is (= 2 @calls) "background job reuses the caller's computation"))))))) + +(t/deftest expired-read-joins-running-refresh-test (let [calls (atom 0) started (promise) release (promise)] (tu/with-harness - {:auto-sync false - :cache-opts {:max-age 10 :refresh-after 5} + {:cache-opts {:max-age 10 :refresh-after 5} :f (fn [& _] (let [n (swap! calls inc)] (when (= n 2) (deliver started true) - (await! release) - (throw (ex-info "Refresh failed" {}))) + @release) n))} - (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] - (let [cached base-cached-fn] + (fn [{:keys [cached-fn base-cached-fn advance-clock! sync-write-queue!]}] + (let [waiter (atom nil)] (try - (t/is (= 1 (cached :key))) - (sync-write-queue!) - (let [created-at (:created-at (c/entry-status cached :key))] + (t/is (= 1 (cached-fn :key))) + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + @started + (let [pending (in-flight base-cached-fn :key) + joined (promise) + original-computation! @#'c/computation!] (advance-clock! 5) - (t/is (= 1 (cached :key))) - (await! started) - (let [pending (in-flight cached :key)] + (with-redefs [c/computation! + (fn [& args] + (let [result (apply original-computation! args)] + (deliver joined (first result)) + result))] + (reset! waiter (future (cached-fn :key))) + (t/is (identical? pending @joined)) + (t/is (not (realized? pending)) "refresh remains blocked until explicitly released") (deliver release true) - (t/is (thrown-with-msg? clojure.lang.ExceptionInfo #"Refresh failed" (await! pending)))) - (t/is (= created-at (:created-at (c/entry-status cached :key))) "failure does not extend age") - (advance-clock! 5) - (t/is (= 3 (cached :key)) "expired call retries instead of serving failed refresh") - (sync-write-queue!) - (t/is (= 3 @calls))) + (t/is (= 2 @@waiter))) + (t/is (= 2 @calls))) (finally (deliver release true) + (when @waiter @@waiter) (sync-write-queue!)))))))) -(t/deftest falsey-values-are-cache-hits-test - (doseq [value [nil false]] - (tu/with-harness - {:f (constantly value)} - (fn [{:keys [cached-fn n-calls]}] - (t/is (= value (cached-fn :key))) - (t/is (= value (cached-fn :key))) - (t/is (= 1 @n-calls)))) - (let [started (promise) - release (promise) - calls (atom 0)] - (tu/with-harness - {:auto-sync false - :cache-opts {:max-age 10 :refresh-after 5} - :f (fn [& _] - (when (= 2 (swap! calls inc)) - (deliver started true) - (await! release)) - value)} - (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] - (let [cached base-cached-fn] - (try - (t/is (= value (cached :key))) - (sync-write-queue!) +(t/deftest refresh-failure-retains-value-and-retries-test + (with-refresh-jobs + (fn [_ run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] + (let [n (swap! calls inc)] + (when (= n 2) (throw (ex-info "Refresh failed" {}))) + n))} + (fn [{:keys [cached-fn base-cached-fn advance-clock! sync-write-queue!]}] + (t/is (= 1 (cached-fn :key))) + (let [created-at (:created-at (c/entry-status base-cached-fn :key))] (advance-clock! 5) - (t/is (= value (await! (future (cached :key))))) - (await! started) - (let [pending (in-flight cached :key)] - (deliver release true) - (t/is (= value (await! pending)))) + (t/is (= 1 (cached-fn :key))) + (run-next!) + (t/is (= created-at (:created-at (c/entry-status base-cached-fn :key)))) + (t/is (= 1 (cached-fn :key)) "failed refresh leaves the previous value available") + (run-next!) (sync-write-queue!) - (t/is (= value (cached :key))) - (t/is (= 2 @calls)) - (finally - (deliver release true) - (when-let [pending (in-flight cached :key)] (await! pending)) - (sync-write-queue!))))))))) + (t/is (= 3 (cached-fn :key))) + (t/is (= 3 @calls))))))))) -(t/deftest refresh-remains-shared-until-stored-test - (let [calls (atom 0) - writer-started (promise) - writer-release (promise) - refresh-started (promise) - refresh-release (promise)] - (tu/with-harness - {:auto-sync false - :cache-opts {:max-age 10 :refresh-after 5} - :f (fn [& _] - (let [n (swap! calls inc)] - (when (= n 2) - (deliver refresh-started true) - (await! refresh-release)) - n))} - (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] - (let [cached base-cached-fn - queue (:write-queue (meta cached))] - (try - (t/is (= 1 (cached :key))) - (sync-write-queue!) - (.put ^LinkedBlockingQueue queue - {:op-fn (fn [_] (deliver writer-started true) (await! writer-release))}) - (await! writer-started) +(t/deftest falsey-values-are-cache-hits-test + (doseq [refresh-after [nil 5] + value [nil false]] + (with-refresh-jobs + (fn [jobs run-next!] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after refresh-after} + :f (constantly value)} + (fn [{:keys [cached-fn n-calls advance-clock! sync-write-queue!]}] + (t/is (= value (cached-fn :key))) + (t/is (= value (cached-fn :key))) + (t/is (= 1 @n-calls)) (advance-clock! 5) - (t/is (= 1 (cached :key))) - (await! refresh-started) - (let [pending (in-flight cached :key)] - (deliver refresh-release true) - (t/is (= 2 (await! pending))) - (dotimes [_ 10] (t/is (= 1 (cached :key)))) - (t/is (identical? pending (in-flight cached :key))) - (advance-clock! 5) - (t/is (= 2 (cached :key)) "expired reads use computed result pending storage") - (t/is (= 2 @calls))) - (finally - (deliver refresh-release true) - (deliver writer-release true) - (when-let [pending (in-flight cached :key)] (await! pending)) - (sync-write-queue!)))))))) + (t/is (= value (cached-fn :key))) + (when refresh-after + (t/is (= 1 (count @jobs))) + (run-next!) + (sync-write-queue!) + (t/is (= value (cached-fn :key))) + (t/is (= 2 @n-calls))))))))) + +(t/deftest refresh-remains-shared-until-stored-test + (with-refresh-jobs + (fn [_ run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] (swap! calls inc))} + (fn [{:keys [cached-fn base-cached-fn advance-clock! sync-write-queue!]}] + (t/is (= 1 (cached-fn :key))) + (let [writes (atom []) + queue-write! @#'c/queue-write!] + (with-redefs [c/queue-write! + (fn [op] + (if (= (:op-fn op) @#'c/put!) + (swap! writes conj op) + (queue-write! op)))] + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + (let [pending (in-flight base-cached-fn :key)] + (run-next!) + (dotimes [_ 10] (t/is (= 1 (cached-fn :key)))) + (t/is (identical? pending (in-flight base-cached-fn :key))) + (advance-clock! 5) + (t/is (= 2 (cached-fn :key))) + (t/is (= 2 @calls)))) + (doseq [op @writes] (queue-write! op)) + (sync-write-queue!) + (t/is (= 2 (cached-fn :key)))))))))) (t/deftest refresh-shares-transformed-keys-without-blocking-other-keys-test - (let [calls (atom {}) - started (promise) - release (promise)] - (tu/with-harness - {:auto-sync false - :cache-opts {:max-age 10 :refresh-after 5 :args-cache-key sort} - :f (fn [& args] - (let [key (sort args) - n (get (swap! calls update key (fnil inc 0)) key)] - (when (and (= key '(1 2)) (= n 2)) - (deliver started true) - (await! release)) - {:key key :generation n :print-length *print-length*}))} - (fn [{:keys [base-cached-fn advance-clock! sync-write-queue!]}] - (let [cached base-cached-fn] - (try - (t/is (= 1 (:generation (cached 1 2)))) - (sync-write-queue!) + (with-refresh-jobs + (fn [jobs run-next!] + (let [calls (atom {})] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5 :args-cache-key sort} + :f (fn [& args] + (let [key (sort args) + n (get (swap! calls update key (fnil inc 0)) key)] + {:key key :generation n :print-length *print-length*}))} + (fn [{:keys [cached-fn base-cached-fn advance-clock! sync-write-queue!]}] + (t/is (= 1 (:generation (cached-fn 1 2)))) (advance-clock! 5) (binding [*print-length* 7] - (t/is (= 1 (:generation (cached 2 1))))) - (await! started) - (t/is (= 1 (:generation (cached 1 2)))) - (t/is (= 1 (:generation (await! (future (cached 3 4))))) "another key can compute during refresh") - (let [pending (in-flight cached 1 2)] - (t/is (identical? pending (in-flight cached 2 1))) - (deliver release true) - (t/is (= 7 (:print-length (await! pending))) "background refresh conveys caller bindings")) + (t/is (= 1 (:generation (cached-fn 2 1))))) + (t/is (= 1 (:generation (cached-fn 1 2)))) + (t/is (= 1 (count @jobs))) + (t/is (identical? (in-flight base-cached-fn 1 2) (in-flight base-cached-fn 2 1))) + (t/is (= 1 (:generation (cached-fn 3 4))) "another key can compute before the refresh runs") + (run-next!) (sync-write-queue!) - (t/is (= 2 (:generation (cached 2 1)))) - (t/is (= {'(1 2) 2 '(3 4) 1} @calls)) - (finally - (deliver release true) - (when-let [pending (in-flight cached 1 2)] (await! pending)) - (sync-write-queue!)))))))) + (t/is (= 7 (:print-length (cached-fn 2 1)))) + (t/is (= {'(1 2) 2 '(3 4) 1} @calls)))))))) (t/deftest existing-entries-can-opt-into-refresh-test - (let [calls (atom 0) - started (promise) - release (promise) - func (fn [& _] - (let [n (swap! calls inc)] - (when (= n 2) - (deliver started true) - (await! release)) - n))] - (tu/with-harness - {:f func :cache-opts {:max-age 10}} - (fn [{:keys [cached-fn base-cached-fn db advance-clock!]}] - (t/is (= 1 (cached-fn :key))) - (advance-clock! 5) - (t/is (= 1 (cached-fn :key))) - (t/is (= 1 @calls) "omitting refresh-after preserves behavior") - (let [refreshing (c/cache {:db db - :func (:func (meta base-cached-fn)) - :func-name "my-func" - :max-age 10 - :refresh-after {:before-max-age 5}})] - (try - (t/is (= 1 (refreshing :key)) "reads the existing persisted entry") - (await! started) - (let [pending (in-flight refreshing :key)] - (deliver release true) - (t/is (= 2 (await! pending)))) - (tu/sync-write-queue! refreshing) - (t/is (= 2 (cached-fn :key)) "old wrapper sees the replacement") - (finally - (deliver release true) - (when-let [pending (in-flight refreshing :key)] (await! pending)) - (tu/sync-write-queue! refreshing)))))))) + (with-refresh-jobs + (fn [_ run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10} + :f (fn [& _] (swap! calls inc))} + (fn [{:keys [cached-fn base-cached-fn db advance-clock!]}] + (t/is (= 1 (cached-fn :key))) + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + (t/is (= 1 @calls)) + (let [refreshing (c/cache {:db db + :func (:func (meta base-cached-fn)) + :func-name "my-func" + :max-age 10 + :refresh-after {:before-max-age 5}})] + (t/is (= 1 (refreshing :key))) + (run-next!) + (tu/sync-write-queue! refreshing) + (t/is (= 2 (cached-fn :key)))))))))) (t/deftest blocking-computation-failure-after-expiry-test (let [fail? (atom false)] (tu/with-harness {:cache-opts {:max-age 10 :refresh-after 5} :f (fn [& _] - (if @fail? - (throw (ex-info "Upstream unavailable" {})) - :value))} + (if @fail? (throw (ex-info "Upstream unavailable" {})) :value))} (fn [{:keys [cached-fn base-cached-fn advance-clock!]}] (t/is (= :value (cached-fn :key))) (reset! fail? true) (advance-clock! 10) - (t/is (thrown-with-msg? clojure.lang.ExceptionInfo #"Upstream unavailable" (cached-fn :key))) + (t/is (thrown-with-msg? ExceptionInfo #"Upstream unavailable" (cached-fn :key))) (t/is (:stale? (c/entry-status base-cached-fn :key))) (reset! fail? false) - (t/is (= :value (cached-fn :key)) "failed computation can be retried"))))) + (t/is (= :value (cached-fn :key))))))) + +(t/deftest named-caches-do-not-share-refresh-computations-test + (with-refresh-jobs + (fn [jobs run-next!] + (let [calls (atom 0)] + (tu/with-harness + {:cache-opts {:max-age 10 :refresh-after 5} + :f (fn [& _] (swap! calls inc))} + (fn [{:keys [cached-fn base-cached-fn db advance-clock! sync-write-queue!]}] + (let [other (c/cache {:db db :func (:func (meta base-cached-fn)) + :func-name "other" :max-age 10 :refresh-after 5})] + (t/is (= 1 (cached-fn :key))) + (t/is (= 2 (other :key))) + (tu/sync-write-queue! other) + (advance-clock! 5) + (t/is (= 1 (cached-fn :key))) + (t/is (= 2 (other :key))) + (t/is (= 2 (count @jobs)) "separate database entries each need a refresh") + (run-next!) + (sync-write-queue!) + (run-next!) + (tu/sync-write-queue! other) + (t/is (= 3 (cached-fn :key))) + (t/is (= 4 (other :key)))))))))) From 0c02d44cfb8aba2d2f3bf465ac64ded1365d4ac5 Mon Sep 17 00:00:00 2001 From: Laurens Van Houtven Date: Thu, 15 Oct 2026 10:03:41 -0500 Subject: [PATCH 3/3] Document shared refresh computation lifecycle --- src/com/latacora/sqlite_cache/core.clj | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/com/latacora/sqlite_cache/core.clj b/src/com/latacora/sqlite_cache/core.clj index 1663a5b..9b288cd 100644 --- a/src/com/latacora/sqlite_cache/core.clj +++ b/src/com/latacora/sqlite_cache/core.clj @@ -175,6 +175,19 @@ (println "put-queue changed from" old "to" new)))) (defn- computation! + "Returns `[shared-delay new?]` for a computation keyed by + `[db func-name func cache-args]`. Registration is atomic; `new?` identifies + the caller that registered the delay. Refresh callers schedule it only when + new; callers needing a value dereference it to run or join the computation. + + On dereference, rechecks the cache because another refresh may have been + stored since the caller's lookup. A fresh entry supplies the value without + calling `func`. Otherwise, computes with `args` and queues an asynchronous + write; the value is available before that write completes. + + The registration remains until `put!` finishes its database write, so readers + arriving before persistence share the result. Reusing a fresh entry or a + failure during lookup, computation, or enqueueing removes it immediately." [{:keys [func func-name db] :as opts} cache-args serialized-args args] (let [queue-key [db func-name func cache-args] computation