From ea40c5dbc2b47d6fd2a23236828dc9e4ab1f77dc Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Sat, 4 Sep 2021 13:23:07 +0200
Subject: Initial commit

Add release script

Release 0.1.3

Use com.github.ivarref.yoltq namespace

Use com.github.ivarref.yoltq namespace
---
 src/com/github/ivarref/yoltq.clj                   | 175 +++++++++++++++++++++
 src/com/github/ivarref/yoltq/error_poller.clj      | 109 +++++++++++++
 src/com/github/ivarref/yoltq/ext_sys.clj           |  26 +++
 src/com/github/ivarref/yoltq/impl.clj              | 147 +++++++++++++++++
 src/com/github/ivarref/yoltq/poller.clj            |  51 ++++++
 src/com/github/ivarref/yoltq/report_queue.clj      |  54 +++++++
 .../ivarref/yoltq/slow_executor_detector.clj       |  28 ++++
 src/com/github/ivarref/yoltq/utils.clj             | 154 ++++++++++++++++++
 src/com/github/ivarref/yoltq/virtual_queue.clj     |  94 +++++++++++
 9 files changed, 838 insertions(+)
 create mode 100644 src/com/github/ivarref/yoltq.clj
 create mode 100644 src/com/github/ivarref/yoltq/error_poller.clj
 create mode 100644 src/com/github/ivarref/yoltq/ext_sys.clj
 create mode 100644 src/com/github/ivarref/yoltq/impl.clj
 create mode 100644 src/com/github/ivarref/yoltq/poller.clj
 create mode 100644 src/com/github/ivarref/yoltq/report_queue.clj
 create mode 100644 src/com/github/ivarref/yoltq/slow_executor_detector.clj
 create mode 100644 src/com/github/ivarref/yoltq/utils.clj
 create mode 100644 src/com/github/ivarref/yoltq/virtual_queue.clj

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
new file mode 100644
index 0000000..565c01d
--- /dev/null
+++ b/src/com/github/ivarref/yoltq.clj
@@ -0,0 +1,175 @@
+(ns com.github.ivarref.yoltq
+  (:require [datomic-schema.core]
+            [datomic.api :as d]
+            [clojure.tools.logging :as log]
+            [com.github.ivarref.yoltq.impl :as i]
+            [com.github.ivarref.yoltq.report-queue :as rq]
+            [com.github.ivarref.yoltq.poller :as poller]
+            [com.github.ivarref.yoltq.error-poller :as errpoller]
+            [com.github.ivarref.yoltq.slow-executor-detector :as slow-executor]
+            [com.github.ivarref.yoltq.utils :as u])
+  (:import (datomic Connection)
+           (java.util.concurrent Executors TimeUnit ExecutorService)
+           (java.time Duration)))
+
+
+(defonce ^:dynamic *config* (atom nil))
+(defonce threadpool (atom nil))
+(defonce ^:dynamic *running?* (atom false))
+(defonce ^:dynamic *test-mode* false)
+
+
+(def default-opts
+  (-> {; Default number of times a queue job will be retried before giving up
+       ; Can be overridden on a per consumer basis with
+       ; (yq/add-consumer! :q (fn [payload] ...) {:max-retries 200})
+       :max-retries                   100
+
+       ; Minimum amount of time to wait before a failed queue job is retried
+       :error-backoff-time            (Duration/ofSeconds 5)
+
+       ; Max time a queue job can execute before an error is logged
+       :max-execute-time              (Duration/ofMinutes 5)
+
+       ; Amount of time an in progress queue job can run before it is considered failed
+       ; and will be marked as such.
+       :hung-backoff-time             (Duration/ofMinutes 30)
+
+       ; Most queue jobs in init state will be consumed by the tx-report-queue listener.
+       ; However in the case where a init job was added right before the application
+       ; was shut down and did not have time to be processed by the tx-report-queue listener,
+       ; it will be consumer by the init poller. This init poller backs off by
+       ; :init-backoff-time to avoid unnecessary compare-and-swap lock failures that could
+       ; otherwise occur if competing with the tx-report-queue listener.
+       :init-backoff-time             (Duration/ofSeconds 60)
+
+       ; How frequent polling for init, error and hung jobs should be done.
+       :poll-delay                    (Duration/ofSeconds 10)
+
+       ; Specifies the number of threads available for executing queue and polling jobs.
+       ; The final thread pool will be this size + 2.
+       ;
+       ; One thread is permanently allocated for listening to the
+       ; tx-report-queue.
+       ;
+       ; Another thread is permanently allocated for checking :max-execute-time.
+       ; This means that if all executing queue jobs are stuck and the thread pool is unavailable
+       ; as such, at least an error will be logged about this. The log entry will
+       ; contain the stacktrace of the stuck threads.
+       :pool-size                     4
+
+       ; How often should the system be polled for failed queue jobs
+       :system-error-poll-delay       (Duration/ofMinutes 1)
+
+       ; How often should the system invoke
+       :system-error-callback-backoff (Duration/ofHours 1)}
+
+      u/duration->nanos))
+
+
+(defn init! [{:keys [conn] :as cfg}]
+  (assert (instance? Connection conn) (str "Expected :conn to be of type datomic Connection. Was: " (or (some-> conn class str) "nil")))
+  (locking threadpool
+    @(d/transact conn i/schema)
+    (let [new-cfg (swap! *config*
+                         (fn [old-conf]
+                           (-> (merge-with (fn [a b] (or b a))
+                                           {:running-queues     (atom #{})
+                                            :start-execute-time (atom {})}
+                                           default-opts
+                                           old-conf
+                                           cfg)
+                               (assoc :system-error (atom {}))
+                               u/duration->nanos)))]
+      new-cfg)))
+
+
+(defn add-consumer!
+  ([queue-id f]
+   (add-consumer! queue-id f {}))
+  ([queue-id f opts]
+   (swap! *config* (fn [old-config] (assoc-in old-config [:handlers queue-id] (merge opts {:f f}))))))
+
+
+(defn put [id payload]
+  (let [{:keys [bootstrap-poller! conn] :as cfg} @*config*]
+    (when (and *test-mode* bootstrap-poller!)
+      (bootstrap-poller! conn))
+    (i/put cfg id payload)))
+
+
+(defn- do-start! []
+  (let [{:keys [poll-delay pool-size system-error-poll-delay]} @*config*]
+    (reset! threadpool (Executors/newScheduledThreadPool (+ 2 pool-size)))
+    (let [pool @threadpool
+          queue-listener-ready (promise)]
+      (reset! *running?* true)
+      (.scheduleAtFixedRate pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/NANOSECONDS)
+      (.scheduleAtFixedRate pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/NANOSECONDS)
+      (.execute pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
+      (.execute pool (fn [] (slow-executor/show-slow-threads *running?* *config*)))
+      @queue-listener-ready)))
+
+
+(defn start! []
+  (locking threadpool
+    (cond (true? *test-mode*)
+          (log/info "test mode enabled, doing nothing for start!")
+
+          (true? @*running?*)
+          nil
+
+          (false? @*running?*)
+          (do-start!))))
+
+
+(defn stop! []
+  (locking threadpool
+    (cond (true? *test-mode*)
+          (log/info "test mode enabled, doing nothing for stop!")
+
+          (false? @*running?*)
+          nil
+
+          (true? @*running?*)
+          (do
+            (reset! *running?* false)
+            (when-let [^ExecutorService tp @threadpool]
+              (log/debug "shutting down old threadpool")
+              (.shutdown tp)
+              (while (not (.awaitTermination tp 1 TimeUnit/SECONDS))
+                (log/debug "waiting for threadpool to stop"))
+              (log/debug "stopped!")
+              (reset! threadpool nil))))))
+
+
+(comment
+  (do
+    (require 'com.github.ivarref.yoltq.log-init)
+    (com.github.ivarref.yoltq.log-init/init-logging!
+      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
+       [#{"ivarref.yoltq.report-queue"} :info]
+       [#{"ivarref.yoltq.poller"} :info]
+       [#{"ivarref.yoltq*"} :info]
+       [#{"*"} :info]])
+    (stop!)
+    (let [received (atom [])
+          uri (str "datomic:mem://demo")]
+      (d/delete-database uri)
+      (d/create-database uri)
+      (let [ok-items (atom [])
+            conn (d/connect uri)
+            n 100]
+        (init! {:conn                          conn
+                :error-backoff-time            (Duration/ofSeconds 1)
+                :poll-delay                    (Duration/ofSeconds 1)})
+        (add-consumer! :q (fn [payload]
+                            (when (> (Math/random) 0.5)
+                              (throw (ex-info "oops" {})))
+                            (if (= n (count (swap! received conj (:work payload))))
+                              (log/info "... and we are done!")
+                              (log/info "got payload" payload "total ok:" (count @received)))))
+        (start!)
+        (dotimes [x n]
+          @(d/transact conn [(put :q {:work x})]))
+        nil))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/error_poller.clj b/src/com/github/ivarref/yoltq/error_poller.clj
new file mode 100644
index 0000000..77339f7
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/error_poller.clj
@@ -0,0 +1,109 @@
+(ns com.github.ivarref.yoltq.error-poller
+  (:require [datomic.api :as d]
+            [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [clojure.tools.logging :as log]))
+
+
+(defn get-state [v]
+  (case v
+    [:error :none] :recovery
+    [:error :some] :error
+    [:error :all] :error
+    [:recovery :none] :recovery
+    [:recovery :some] :recovery
+    [:recovery :all] :error
+    nil))
+
+
+(defn handle-error-count [{:keys [errors last-notify state]
+                           :or   {errors      []
+                                  last-notify 0
+                                  state       :recovery}}
+                          {:keys [system-error-min-count system-error-callback-backoff]
+                           :or   {system-error-min-count 3}}
+                          now-ns
+                          error-count]
+  (let [new-errors (->> (conj errors error-count)
+                        (take-last system-error-min-count)
+                        (vec))
+        classify (fn [coll]
+                   (cond
+                     (not= system-error-min-count (count coll))
+                     :missing
+
+                     (every? pos-int? coll)
+                     :all
+
+                     (every? zero? coll)
+                     :none
+
+                     :else
+                     :some))
+        old-state state]
+    (merge
+      {:errors      new-errors
+       :last-notify last-notify}
+      (when-let [new-state (get-state [old-state (classify new-errors)])]
+        (merge
+          {:state new-state}
+          (when (and (= old-state :recovery)
+                     (= new-state :error))
+            {:run-callback :error
+             :last-notify  now-ns})
+
+          (when (and (= new-state :error)
+                     (= old-state :error)
+                     (> now-ns
+                        (+ last-notify system-error-callback-backoff)))
+            {:run-callback :error
+             :last-notify  now-ns})
+
+          (when (and (= new-state :recovery)
+                     (= old-state :error))
+            {:run-callback :recovery}))))))
+
+
+(defn do-poll-errors [{:keys [conn system-error
+                              on-system-error
+                              on-system-recovery]
+                       :or   {on-system-error    (fn [] nil)
+                              on-system-recovery (fn [] nil)}
+                       :as   config}]
+  (assert (some? conn) "expected :conn to be present")
+  (assert (some? system-error) "expected :system-error to be present")
+  (let [error-count (or (d/q '[:find (count ?e) .
+                               :in $ ?status
+                               :where
+                               [?e :com.github.ivarref.yoltq/status ?status]]
+                             (d/db conn)
+                             u/status-error)
+                        0)]
+    (when (pos-int? error-count)
+      (log/debug "poll-errors found" error-count "errors in system"))
+    (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config (ext/now-ns) error-count)]
+      (when run-callback
+        (cond (= run-callback :error)
+              (on-system-error)
+
+              (= run-callback :recovery)
+              (on-system-recovery)
+
+              :else
+              (log/error "unhandled callback-type" run-callback))
+        (log/debug "run-callback is" run-callback))
+      new-state)))
+
+
+(defn poll-errors [running? config-atom]
+  (try
+    (when @running?
+      (do-poll-errors @config-atom))
+    (catch Throwable t
+      (log/error t "unexpected error in poll-erros:" (ex-message t))
+      nil)))
+
+
+(comment
+  (do-poll-errors @com.github.ivarref.yoltq/*config*))
+
diff --git a/src/com/github/ivarref/yoltq/ext_sys.clj b/src/com/github/ivarref/yoltq/ext_sys.clj
new file mode 100644
index 0000000..3480475
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/ext_sys.clj
@@ -0,0 +1,26 @@
+(ns com.github.ivarref.yoltq.ext-sys
+  (:require [datomic.api :as d])
+  (:import (java.util UUID)))
+
+
+(def ^:dynamic *now-ns-atom* nil)
+(def ^:dynamic *squuid-atom* nil)
+(def ^:dynamic *random-atom* nil)
+
+
+(defn now-ns []
+  (if *now-ns-atom*
+    @*now-ns-atom*
+    (System/nanoTime)))
+
+
+(defn squuid []
+  (if *squuid-atom*
+    (UUID/fromString (str "00000000-0000-0000-0000-" (format "%012d" (swap! *squuid-atom* inc))))
+    (d/squuid)))
+
+
+(defn random-uuid []
+  (if *random-atom*
+    (UUID/fromString (str "00000000-0000-0000-0000-" (format "%012d" (swap! *random-atom* inc))))
+    (UUID/randomUUID)))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
new file mode 100644
index 0000000..2acc83d
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -0,0 +1,147 @@
+(ns com.github.ivarref.yoltq.impl
+  (:require [datomic.api :as d]
+            [clojure.tools.logging :as log]
+            [clojure.string :as str]
+            [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.ext-sys :as ext]))
+
+
+(def schema
+  [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
+   #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
+   #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
+   #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
+   #:db{:ident :com.github.ivarref.yoltq/bindings, :cardinality :db.cardinality/one, :valueType :db.type/string}
+   #:db{:ident :com.github.ivarref.yoltq/tries, :cardinality :db.cardinality/one, :valueType :db.type/long, :noHistory true}
+   #:db{:ident :com.github.ivarref.yoltq/lock, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :noHistory true}
+   #:db{:ident :com.github.ivarref.yoltq/init-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
+   #:db{:ident :com.github.ivarref.yoltq/processing-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
+   #:db{:ident :com.github.ivarref.yoltq/done-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
+   #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}])
+
+
+(defn put [config queue-name payload]
+  (if-let [_ (get-in config [:handlers queue-name])]
+    (let [id (u/squuid)]
+      (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
+      {:com.github.ivarref.yoltq/id         id
+       :com.github.ivarref.yoltq/queue-name queue-name
+       :com.github.ivarref.yoltq/status     u/status-init
+       :com.github.ivarref.yoltq/payload    (pr-str payload)
+       :com.github.ivarref.yoltq/bindings   (pr-str {})
+       :com.github.ivarref.yoltq/lock       (u/random-uuid)
+       :com.github.ivarref.yoltq/tries      0
+       :com.github.ivarref.yoltq/init-time  (u/now-ns)})
+    (do
+      (log/error "Did not find registered handler for queue" queue-name)
+      (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
+
+
+(defn take! [{:keys [conn cas-failures hung-log-level]
+              :or   {hung-log-level :error}}
+             {:keys [tx id queue-name was-hung? to-error?] :as queue-item-info}]
+  (when queue-item-info
+    (try
+      (cond to-error?
+            (log/logp hung-log-level "queue-item" (str id) "was hung and retried too many times. Giving up!")
+
+            was-hung?
+            (log/logp hung-log-level "queue-item" (str id) "was hung, retrying ...")
+
+            :else
+            nil)
+      (let [{:keys [db-after]} @(d/transact conn tx)
+            {:com.github.ivarref.yoltq/keys [status] :as q-item} (u/get-queue-item db-after id)]
+        (log/debug "queue item" (str id) "for queue" queue-name "now has status" status)
+        q-item)
+      (catch Throwable t
+        (let [{:db/keys [error] :as m} (u/db-error-map t)]
+          (cond
+            (= :db.error/cas-failed error)
+            (do
+              (log/info ":db.error/cas-failed for queue item" (str id) "and attribute" (:a m))
+              (when cas-failures
+                (swap! cas-failures inc))
+              nil)
+
+            :else
+            (do
+              (log/error t "Unexpected failure for queue item" (str id) ":" (ex-message t))
+              nil)))))))
+
+
+(defn mark-status! [{:keys [conn]}
+                    {:com.github.ivarref.yoltq/keys [id lock tries]}
+                    new-status]
+  (try
+    (let [tx [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock lock (u/random-uuid)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing new-status]
+              (if (= new-status u/status-done)
+                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/done-time (u/now-ns)}
+                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time (u/now-ns)})]
+          {:keys [db-after]} @(d/transact conn tx)]
+      (u/get-queue-item db-after id))
+    (catch Throwable t
+      (log/error t "unexpected error in mark-status!: " (ex-message t))
+      nil)))
+
+
+(defn fmt [id queue-name new-status tries spent-ns]
+  (str/join " " ["queue-item" (str id)
+                 "for queue" queue-name
+                 "now has status" new-status
+                 "after" tries (if (= 1 tries)
+                                 "try"
+                                 "tries")
+                 "in" (format "%.1f" (double (/ spent-ns 1e6))) "ms"]))
+
+
+(defn execute! [{:keys [handlers mark-status-fn! start-execute-time]
+                 :or   {mark-status-fn! mark-status!}
+                 :as   cfg}
+                {:com.github.ivarref.yoltq/keys [status id queue-name payload] :as queue-item}]
+  (when queue-item
+    (if (= :error status)
+      (assoc queue-item :failed? true)
+      (if-let [queue (get handlers queue-name)]
+        (let [{:keys [f allow-cas-failure?]} queue]
+          (log/debug "queue item" (str id) "for queue" queue-name "is now processing")
+          (let [{:keys [retval exception]}
+                (try
+                  (swap! start-execute-time assoc (Thread/currentThread) [(ext/now-ns) id queue-name])
+                  (let [v (f payload)]
+                    {:retval v})
+                  (catch Throwable t
+                    {:exception t})
+                  (finally
+                    (swap! start-execute-time dissoc (Thread/currentThread))))
+                {:db/keys [error] :as m} (u/db-error-map exception)]
+            (cond
+              (and (some? exception)
+                   allow-cas-failure?
+                   (= :db.error/cas-failed error)
+                   (or (true? allow-cas-failure?)
+                       (allow-cas-failure? (:a m))))
+              (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
+                (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
+                  (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
+                  (assoc q-item :retval retval :success? true :allow-cas-failure? true)))
+
+              (some? exception)
+              (when-let [q-item (mark-status-fn! cfg queue-item u/status-error)]
+                (let [{:com.github.ivarref.yoltq/keys [init-time error-time tries]} q-item
+                      level (if (>= tries 3) :error :warn)]
+                  (log/logp level exception (fmt id queue-name u/status-error tries (- error-time init-time)))
+                  (log/logp level exception "error message was:" (str \" (ex-message exception) \") "for queue-item" (str id))
+                  (log/logp level exception "ex-data was:" (ex-data exception) "for queue-item" (str id))
+                  (assoc q-item :exception exception)))
+
+              :else
+              (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
+                (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
+                  (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
+                  (assoc q-item :retval retval :success? true))))))
+        (do
+          (log/error "no handler for queue" queue-name)
+          nil)))))
diff --git a/src/com/github/ivarref/yoltq/poller.clj b/src/com/github/ivarref/yoltq/poller.clj
new file mode 100644
index 0000000..ad9d32a
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/poller.clj
@@ -0,0 +1,51 @@
+(ns com.github.ivarref.yoltq.poller
+  (:require [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.impl :as i]
+            [clojure.tools.logging :as log]))
+
+
+(defn poll-once! [cfg q status]
+  (case status
+    :init (some->> (u/get-init cfg q) (i/take! cfg) (i/execute! cfg))
+    :error (some->> (u/get-error cfg q) (i/take! cfg) (i/execute! cfg))
+    :hung (some->> (u/get-hung cfg q) (i/take! cfg) (i/execute! cfg))))
+
+
+(defn poll-queue! [running?
+                   {:keys [running-queues] :as cfg}
+                   [queue-name status :as q]]
+  (try
+    (let [[old _] (swap-vals! running-queues conj q)]
+      (if-not (contains? old q)
+        (try
+          (log/debug "polling queue" queue-name "for status" status)
+          (let [start-time (u/now-ns)
+                last-res (loop [prev-res nil]
+                           (when @running?
+                             (let [res (poll-once! cfg queue-name status)]
+                               (if (and res (:success? res))
+                                 (recur res)
+                                 prev-res))))]
+            (let [spent-ns (- (u/now-ns) start-time)]
+              (log/trace "done polling queue" q "in"
+                         (format "%.1f" (double (/ spent-ns 1e6)))
+                         "ms"))
+            last-res)
+          (finally
+            (swap! running-queues disj q)))
+        (log/debug "queue" q "is already being polled, doing nothing...")))
+    (catch Throwable t
+      (log/error t "poll-queue! crashed:" (ex-message t)))
+    (finally)))
+
+
+(defn poll-all-queues! [running? config-atom pool]
+  (try
+    (when @running?
+      (let [{:keys [handlers]} @config-atom]
+        (doseq [q (shuffle (vec (for [q-name (keys handlers)
+                                      status [:init :error :hung]]
+                                  [q-name status])))]
+          (.execute pool (fn [] (poll-queue! running? @config-atom q))))))
+    (catch Throwable t
+      (log/error t "poll-all-queues! crashed:" (ex-message t)))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
new file mode 100644
index 0000000..a40d29a
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -0,0 +1,54 @@
+(ns com.github.ivarref.yoltq.report-queue
+  (:require [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.impl :as i]
+            [datomic.api :as d]
+            [clojure.tools.logging :as log])
+  (:import (datomic Datom)
+           (java.util.concurrent ScheduledExecutorService BlockingQueue TimeUnit)))
+
+
+(defn process-poll-result! [cfg id-ident poll-result consumer]
+  (let [{:keys [tx-data db-after]} poll-result]
+    (when-let [new-ids (->> tx-data
+                            (filter (fn [^Datom datom] (and
+                                                         (= (.a datom) id-ident)
+                                                         (.added datom))))
+                            (mapv (fn [^Datom datom] (.v datom)))
+                            (into [])
+                            (not-empty))]
+      (doseq [id new-ids]
+        (consumer (fn []
+                    (try
+                      (let [{:com.github.ivarref.yoltq/keys [lock id status queue-name]} (u/get-queue-item db-after id)]
+                        (some->>
+                          (u/prepare-processing id queue-name lock status)
+                          (i/take! cfg)
+                          (i/execute! cfg)))
+                      (catch Throwable t
+                        (log/error t "unexpected error in process-poll-result!")))))))))
+
+
+(defn report-queue-listener [running?
+                             ready?
+                             ^ScheduledExecutorService pool
+                             config-atom]
+  (let [conn (:conn @config-atom)
+        ^BlockingQueue q (d/tx-report-queue conn)
+        id-ident (d/q '[:find ?e .
+                        :where [?e :db/ident :com.github.ivarref.yoltq/id]]
+                      (d/db conn))]
+    (try
+      (while @running?
+        (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
+          (process-poll-result! @config-atom
+                                id-ident
+                                poll-result
+                                (fn [f]
+                                  (when @running?
+                                    (.execute ^ScheduledExecutorService pool f)))))
+        (deliver ready? true))
+      (catch Throwable t
+        (log/error t "unexpected error in report-queue-listener"))
+      (finally
+        (log/debug "remove tx-report-queue")
+        (d/remove-tx-report-queue conn)))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/slow_executor_detector.clj b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
new file mode 100644
index 0000000..f15ef7d
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
@@ -0,0 +1,28 @@
+(ns com.github.ivarref.yoltq.slow-executor-detector
+  (:require [com.github.ivarref.yoltq.ext-sys :as ext]
+            [clojure.tools.logging :as log]
+            [clojure.string :as str]))
+
+
+(defn- do-show-slow-threads [{:keys [start-execute-time
+                                     max-execute-time]}]
+  (doseq [[^Thread thread [start-time queue-id queue-name]] @start-execute-time]
+    (when (> (ext/now-ns) (+ start-time max-execute-time))
+      (log/error "thread" (.getName thread) "spent too much time on"
+                 "queue item" (str queue-id)
+                 "for queue" queue-name
+                 "stacktrace: \n"
+                 (str/join "\n" (mapv str (seq (.getStackTrace thread))))))))
+
+
+(defn show-slow-threads [running? config-atom]
+  (try
+    (while @running?
+      (try
+        (do-show-slow-threads @config-atom)
+        (catch Throwable t
+          (log/error t "do-show-slow-threads crashed:" (ex-message t))))
+      (dotimes [_ 3]
+        (when @running? (Thread/sleep 1000))))
+    (catch Throwable t
+      (log/error t "reap! crashed:" (ex-message t)))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
new file mode 100644
index 0000000..c96d1dc
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -0,0 +1,154 @@
+(ns com.github.ivarref.yoltq.utils
+  (:require [datomic.api :as d]
+            [clojure.edn :as edn]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [clojure.tools.logging :as log])
+  (:import (datomic Connection)
+           (java.time Duration)))
+
+
+(def status-init :init)
+(def status-processing :processing)
+(def status-done :done)
+(def status-error :error)
+
+
+(defn duration->nanos [m]
+  (reduce-kv (fn [o k v]
+               (if (instance? Duration v)
+                 (assoc o k (.toNanos v))
+                 (assoc o k v)))
+             {}
+             m))
+
+
+(defn squuid []
+  (ext/squuid))
+
+
+(defn random-uuid []
+  (ext/random-uuid))
+
+
+(defn now-ns []
+  (ext/now-ns))
+
+
+(defn root-cause [e]
+  (if-let [root (ex-cause e)]
+    (root-cause root)
+    e))
+
+
+(defn db-error-map [^Throwable t]
+  (loop [e t]
+    (cond (nil? e) nil
+
+          (and (map? (ex-data e))
+               (contains? (ex-data e) :db/error))
+          (ex-data e)
+
+          :else
+          (recur (ex-cause e)))))
+
+
+(defn get-queue-item [db id]
+  (-> (d/pull db '[:*] [:com.github.ivarref.yoltq/id id])
+      (dissoc :db/id)
+      (update :com.github.ivarref.yoltq/payload edn/read-string)
+      (update :com.github.ivarref.yoltq/bindings edn/read-string)))
+
+
+(defn prepare-processing [id queue-name old-lock old-status]
+  (let [new-lock (random-uuid)]
+    {:id         id
+     :lock       new-lock
+     :queue-name queue-name
+     :tx         [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
+                  [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status old-status status-processing]
+                  {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/processing-time (now-ns)}]}))
+
+
+(defn get-init [{:keys [conn db init-backoff-time] :as cfg} queue-name]
+  (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
+                                           (str (if (nil? conn) "nil" conn))
+                                           "\nConfig was: " (str cfg)))
+  (if-let [ids (->> (d/q '[:find ?id ?lock
+                           :in $ ?queue-name ?backoff
+                           :where
+                           [?e :com.github.ivarref.yoltq/status :init]
+                           [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
+                           [?e :com.github.ivarref.yoltq/init-time ?init-time]
+                           [(>= ?backoff ?init-time)]
+                           [?e :com.github.ivarref.yoltq/id ?id]
+                           [?e :com.github.ivarref.yoltq/lock ?lock]]
+                         (or db (d/db conn))
+                         queue-name
+                         (- (now-ns) init-backoff-time))
+                    (not-empty))]
+    (let [[id old-lock] (rand-nth (into [] ids))]
+      (prepare-processing id queue-name old-lock :init))
+    (log/trace "no new-items in :init status for queue" queue-name)))
+
+
+(defn get-error [{:keys [conn db error-backoff-time max-retries] :as cfg} queue-name]
+  (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
+                                           (str (if (nil? conn) "nil" conn))
+                                           "\nConfig was: " (str cfg)))
+  (let [max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
+    (when-let [ids (->> (d/q '[:find ?id ?lock
+                               :in $ ?queue-name ?backoff ?max-tries
+                               :where
+                               [?e :com.github.ivarref.yoltq/status :error]
+                               [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
+                               [?e :com.github.ivarref.yoltq/error-time ?time]
+                               [(>= ?backoff ?time)]
+                               [?e :com.github.ivarref.yoltq/tries ?tries]
+                               [(> ?max-tries ?tries)]
+                               [?e :com.github.ivarref.yoltq/id ?id]
+                               [?e :com.github.ivarref.yoltq/lock ?lock]]
+                             (or db (d/db conn))
+                             queue-name
+                             (- (now-ns) error-backoff-time)
+                             (inc max-retries))
+                        (not-empty))]
+      (let [[id old-lock] (rand-nth (into [] ids))]
+        (prepare-processing id queue-name old-lock :error)))))
+
+
+(defn get-hung [{:keys [conn db now hung-backoff-time max-retries] :as cfg} queue-name]
+  (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
+                                           (str (if (nil? conn) "nil" conn))
+                                           "\nConfig was: " (str cfg)))
+  (let [now (or now (now-ns))
+        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
+    (when-let [ids (->> (d/q '[:find ?id ?lock ?tries
+                               :in $ ?qname ?backoff
+                               :where
+                               [?e :com.github.ivarref.yoltq/status :processing]
+                               [?e :com.github.ivarref.yoltq/queue-name ?qname]
+                               [?e :com.github.ivarref.yoltq/processing-time ?time]
+                               [(>= ?backoff ?time)]
+                               [?e :com.github.ivarref.yoltq/tries ?tries]
+                               [?e :com.github.ivarref.yoltq/id ?id]
+                               [?e :com.github.ivarref.yoltq/lock ?lock]]
+                             (or db (d/db conn))
+                             queue-name
+                             (- now hung-backoff-time))
+                        (not-empty))]
+      (let [new-lock (random-uuid)
+            [id old-lock tries _t] (rand-nth (into [] ids))
+            to-error? (>= tries max-retries)]
+        {:id         id
+         :lock       new-lock
+         :queue-name queue-name
+         :was-hung?  true
+         :to-error?  to-error?
+         :tx         (if (not to-error?)
+                       [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
+                        [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
+                        {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time now}]
+                       [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
+                        [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
+                        [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status status-processing status-error]
+                        {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time now}])}))))
diff --git a/src/com/github/ivarref/yoltq/virtual_queue.clj b/src/com/github/ivarref/yoltq/virtual_queue.clj
new file mode 100644
index 0000000..e49aca3
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/virtual_queue.clj
@@ -0,0 +1,94 @@
+(ns com.github.ivarref.yoltq.virtual-queue
+  (:require [clojure.tools.logging :as log]
+            [com.github.ivarref.yoltq.report-queue :as rq]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [com.github.ivarref.yoltq :as dq]
+            [datomic.api :as d]
+            [com.github.ivarref.yoltq.poller :as poller])
+  (:import (java.util.concurrent BlockingQueue TimeUnit)))
+
+
+(defn bootstrap-poller! [txq running? poller-exited? bootstrapped? conn]
+  (let [ready? (promise)]
+    (future
+      (let [q (d/tx-report-queue conn)]
+        (try
+          (while @running?
+            (when-let [poll-result (.poll ^BlockingQueue q 10 TimeUnit/MILLISECONDS)]
+              (swap! txq conj poll-result))
+            (deliver ready? true)
+            (reset! bootstrapped? true))
+          (catch Throwable t
+            (log/error t "test-poller crashed: " (ex-message t)))
+          (finally
+            (try
+              (d/remove-tx-report-queue conn)
+              (catch Throwable t
+                (log/warn t "remove-tx-report-queue failed:" (ex-message t))))
+            (deliver poller-exited? true)))))
+    @ready?))
+
+
+(defmacro with-virtual-queue!
+  [& body]
+  `(let [txq# (atom [])
+         poller-exited?# (promise)
+         bootstrapped?# (atom false)
+         running?# (atom true)
+         config# (atom {:bootstrap-poller! (partial bootstrap-poller! txq# running?# poller-exited?# bootstrapped?#)
+                        :init-backoff-time 0
+                        :hung-log-level    :warn
+                        :tx-queue          txq#})]
+     (with-bindings {#'dq/*config*       config#
+                     #'dq/*running?*     (atom false)
+                     #'dq/*test-mode*    true
+                     #'ext/*now-ns-atom* (atom 0)
+                     #'ext/*random-atom* (atom 0)
+                     #'ext/*squuid-atom* (atom 0)}
+       (try
+         ~@body
+         (finally
+           (reset! running?# false)
+           (when @bootstrapped?#
+             @poller-exited?#))))))
+
+
+(defn call-with-virtual-queue!
+  [f]
+  (with-virtual-queue!
+    (f)))
+
+
+(defn run-report-queue! [min-items]
+  (let [{:keys [tx-queue conn]} @dq/*config*
+        id-ident (d/q '[:find ?e .
+                        :where [?e :db/ident :com.github.ivarref.yoltq/id]]
+                      (d/db conn))]
+    (let [timeout (+ 3000 (System/currentTimeMillis))]
+      (while (and (< (System/currentTimeMillis) timeout)
+                  (< (count @tx-queue) min-items))
+        (Thread/sleep 10)))
+    (when (< (count @tx-queue) min-items)
+      (let [msg (str "run-report-queue: timeout waiting for " min-items " items")]
+        (log/error msg)
+        (throw (ex-info msg {}))))
+    (let [res (atom [])]
+      (doseq [itm (first (swap-vals! tx-queue (constantly [])))]
+        (rq/process-poll-result!
+          @dq/*config*
+          id-ident
+          itm
+          (fn [f] (swap! res conj (f)))))
+      @res)))
+
+
+(defn run-one-report-queue! []
+  (first (run-report-queue! 1)))
+
+
+(defn run-queue-once! [q status]
+  (poller/poll-once! @dq/*config* q status))
+
+
+(defn put! [q payload]
+  @(d/transact (:conn @dq/*config*) [(dq/put q payload)]))
\ No newline at end of file
-- 
cgit v1.2.3


From f2b96daef274415c8e3ba74ce492ef9c9d183711 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Tue, 14 Sep 2021 19:16:26 +0200
Subject: Add ability to measure time spent on transacting vs. total time
 spent. Using transactor with a real postgres database, one CPU and an no-op
 identity queue consumer, transacting accounts for about 99.5% of the total
 time used.

---
 src/com/github/ivarref/yoltq.clj      |  4 ++--
 src/com/github/ivarref/yoltq/impl.clj | 15 +++++++++++----
 2 files changed, 13 insertions(+), 6 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 565c01d..2eb39e8 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -91,11 +91,11 @@
    (swap! *config* (fn [old-config] (assoc-in old-config [:handlers queue-id] (merge opts {:f f}))))))
 
 
-(defn put [id payload]
+(defn put [queue-id payload]
   (let [{:keys [bootstrap-poller! conn] :as cfg} @*config*]
     (when (and *test-mode* bootstrap-poller!)
       (bootstrap-poller! conn))
-    (i/put cfg id payload)))
+    (i/put cfg queue-id payload)))
 
 
 (defn- do-start! []
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 2acc83d..6a4f105 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -37,7 +37,7 @@
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
 
 
-(defn take! [{:keys [conn cas-failures hung-log-level]
+(defn take! [{:keys [conn cas-failures hung-log-level tx-spent-time!]
               :or   {hung-log-level :error}}
              {:keys [tx id queue-name was-hung? to-error?] :as queue-item-info}]
   (when queue-item-info
@@ -50,7 +50,9 @@
 
             :else
             nil)
-      (let [{:keys [db-after]} @(d/transact conn tx)
+      (let [start-time (System/nanoTime)
+            {:keys [db-after]} @(d/transact conn tx)
+            _ (when tx-spent-time! (tx-spent-time! (- (System/nanoTime) start-time)))
             {:com.github.ivarref.yoltq/keys [status] :as q-item} (u/get-queue-item db-after id)]
         (log/debug "queue item" (str id) "for queue" queue-name "now has status" status)
         q-item)
@@ -70,7 +72,7 @@
               nil)))))))
 
 
-(defn mark-status! [{:keys [conn]}
+(defn mark-status! [{:keys [conn tx-spent-time!]}
                     {:com.github.ivarref.yoltq/keys [id lock tries]}
                     new-status]
   (try
@@ -80,7 +82,9 @@
               (if (= new-status u/status-done)
                 {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/done-time (u/now-ns)}
                 {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time (u/now-ns)})]
+          start-time (System/nanoTime)
           {:keys [db-after]} @(d/transact conn tx)]
+      (when tx-spent-time! (tx-spent-time! (- (System/nanoTime) start-time)))
       (u/get-queue-item db-after id))
     (catch Throwable t
       (log/error t "unexpected error in mark-status!: " (ex-message t))
@@ -97,7 +101,7 @@
                  "in" (format "%.1f" (double (/ spent-ns 1e6))) "ms"]))
 
 
-(defn execute! [{:keys [handlers mark-status-fn! start-execute-time]
+(defn execute! [{:keys [handlers mark-status-fn! start-execute-time collect-spent-time!]
                  :or   {mark-status-fn! mark-status!}
                  :as   cfg}
                 {:com.github.ivarref.yoltq/keys [status id queue-name payload] :as queue-item}]
@@ -126,6 +130,7 @@
               (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
                 (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
                   (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
                   (assoc q-item :retval retval :success? true :allow-cas-failure? true)))
 
               (some? exception)
@@ -135,12 +140,14 @@
                   (log/logp level exception (fmt id queue-name u/status-error tries (- error-time init-time)))
                   (log/logp level exception "error message was:" (str \" (ex-message exception) \") "for queue-item" (str id))
                   (log/logp level exception "ex-data was:" (ex-data exception) "for queue-item" (str id))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
                   (assoc q-item :exception exception)))
 
               :else
               (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
                 (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
                   (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
                   (assoc q-item :retval retval :success? true))))))
         (do
           (log/error "no handler for queue" queue-name)
-- 
cgit v1.2.3


From 988c985666139f5246772c3e5e059c62627ea88b Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Tue, 14 Sep 2021 21:01:16 +0200
Subject: Only keep handlers from old config

---
 src/com/github/ivarref/yoltq.clj | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 2eb39e8..d04462f 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -75,11 +75,11 @@
                          (fn [old-conf]
                            (-> (merge-with (fn [a b] (or b a))
                                            {:running-queues     (atom #{})
-                                            :start-execute-time (atom {})}
+                                            :start-execute-time (atom {})
+                                            :system-error       (atom {})}
                                            default-opts
-                                           old-conf
+                                           (select-keys old-conf [:handlers])
                                            cfg)
-                               (assoc :system-error (atom {}))
                                u/duration->nanos)))]
       new-cfg)))
 
@@ -160,9 +160,9 @@
       (let [ok-items (atom [])
             conn (d/connect uri)
             n 100]
-        (init! {:conn                          conn
-                :error-backoff-time            (Duration/ofSeconds 1)
-                :poll-delay                    (Duration/ofSeconds 1)})
+        (init! {:conn               conn
+                :error-backoff-time (Duration/ofSeconds 1)
+                :poll-delay         (Duration/ofSeconds 1)})
         (add-consumer! :q (fn [payload]
                             (when (> (Math/random) 0.5)
                               (throw (ex-info "oops" {})))
-- 
cgit v1.2.3


From f33b93c569e92db3a1be8c7fd19bcf33937a2432 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Wed, 15 Sep 2021 16:10:09 +0200
Subject: Only keep handlers from old config

---
 src/com/github/ivarref/yoltq.clj | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index d04462f..d3eefef 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -78,7 +78,7 @@
                                             :start-execute-time (atom {})
                                             :system-error       (atom {})}
                                            default-opts
-                                           (select-keys old-conf [:handlers])
+                                           (if *test-mode* old-conf (select-keys old-conf [:handlers]))
                                            cfg)
                                u/duration->nanos)))]
       new-cfg)))
-- 
cgit v1.2.3


From 3800a43e538e9d140ef0227f2417430171865605 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 17 Sep 2021 14:08:22 +0200
Subject: Add consume-expect!

---
 src/com/github/ivarref/yoltq/virtual_queue.clj | 88 +++++++++++++++++++++++---
 1 file changed, 78 insertions(+), 10 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/virtual_queue.clj b/src/com/github/ivarref/yoltq/virtual_queue.clj
index e49aca3..f133bde 100644
--- a/src/com/github/ivarref/yoltq/virtual_queue.clj
+++ b/src/com/github/ivarref/yoltq/virtual_queue.clj
@@ -2,10 +2,14 @@
   (:require [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.report-queue :as rq]
             [com.github.ivarref.yoltq.ext-sys :as ext]
-            [com.github.ivarref.yoltq :as dq]
+            [com.github.ivarref.yoltq :as yq]
             [datomic.api :as d]
-            [com.github.ivarref.yoltq.poller :as poller])
-  (:import (java.util.concurrent BlockingQueue TimeUnit)))
+            [com.github.ivarref.yoltq.poller :as poller]
+            [clojure.test :as test]
+            [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.impl :as i])
+  (:import (java.util.concurrent BlockingQueue TimeUnit)
+           (datomic Datom)))
 
 
 (defn bootstrap-poller! [txq running? poller-exited? bootstrapped? conn]
@@ -39,9 +43,9 @@
                         :init-backoff-time 0
                         :hung-log-level    :warn
                         :tx-queue          txq#})]
-     (with-bindings {#'dq/*config*       config#
-                     #'dq/*running?*     (atom false)
-                     #'dq/*test-mode*    true
+     (with-bindings {#'yq/*config*       config#
+                     #'yq/*running?*     (atom false)
+                     #'yq/*test-mode*    true
                      #'ext/*now-ns-atom* (atom 0)
                      #'ext/*random-atom* (atom 0)
                      #'ext/*squuid-atom* (atom 0)}
@@ -60,7 +64,7 @@
 
 
 (defn run-report-queue! [min-items]
-  (let [{:keys [tx-queue conn]} @dq/*config*
+  (let [{:keys [tx-queue conn]} @yq/*config*
         id-ident (d/q '[:find ?e .
                         :where [?e :db/ident :com.github.ivarref.yoltq/id]]
                       (d/db conn))]
@@ -75,7 +79,7 @@
     (let [res (atom [])]
       (doseq [itm (first (swap-vals! tx-queue (constantly [])))]
         (rq/process-poll-result!
-          @dq/*config*
+          @yq/*config*
           id-ident
           itm
           (fn [f] (swap! res conj (f)))))
@@ -87,8 +91,72 @@
 
 
 (defn run-queue-once! [q status]
-  (poller/poll-once! @dq/*config* q status))
+  (poller/poll-once! @yq/*config* q status))
 
 
 (defn put! [q payload]
-  @(d/transact (:conn @dq/*config*) [(dq/put q payload)]))
\ No newline at end of file
+  @(d/transact (:conn @yq/*config*) [(yq/put q payload)]))
+
+
+(defn transact-result->maps [{:keys [tx-data db-after]}]
+  (let [m (->> tx-data
+               (group-by (fn [^Datom d] (.e d)))
+               (vals)
+               (mapv (fn [datoms]
+                       (reduce (fn [o ^Datom d]
+                                 (if (.added d)
+                                   (assoc o (d/q '[:find ?r .
+                                                   :in $ ?e
+                                                   :where [?e :db/ident ?r]]
+                                                 db-after
+                                                 (.a d))
+                                            (.v d))
+                                   o))
+                               {}
+                               datoms))))]
+    m))
+
+(defn contains-queue-job?
+  [queue-id conn {::yq/keys [id queue-name status] :as m}]
+  (when (and (= queue-id queue-name)
+             (= status :init)
+             (d/q '[:find ?e .
+                    :in $ ?id
+                    :where
+                    [?e ::yq/id ?id]
+                    [?e ::yq/status :init]]
+                  (d/db conn)
+                  id))
+    m))
+
+
+(defn get-tx-q-job [q-id]
+  (let [{:keys [tx-queue conn]} @yq/*config*]
+    (loop [timeout (+ 3000 (System/currentTimeMillis))]
+      (if-let [job (->> @tx-queue
+                        (mapcat transact-result->maps)
+                        (filter (partial contains-queue-job? q-id conn))
+                        (first))]
+        (u/get-queue-item (d/db conn) (::yq/id job))
+        (if (< (System/currentTimeMillis) timeout)
+          (do (Thread/sleep 10)
+              (recur timeout))
+          nil)))))
+
+(defmacro consume-expect! [queue-name expected-status]
+  `(if-let [job# (get-tx-q-job ~queue-name)]
+     (try
+       (let [res# (some->>
+                    (u/prepare-processing (:com.github.ivarref.yoltq/id job#)
+                                          ~queue-name
+                                          (:com.github.ivarref.yoltq/lock job#)
+                                          (:com.github.ivarref.yoltq/status job#))
+                    (i/take! @yq/*config*)
+                    (i/execute! @yq/*config*))]
+         (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
+         (if (:retval res#)
+           (:retval res#)
+           (:exception res#)))
+       (catch Throwable t#
+         (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
+     (test/is nil (str "No job found for queue " ~queue-name))))
\ No newline at end of file
-- 
cgit v1.2.3


From 538f0111dfb02da0f875b5777c97684d451be73a Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 17 Sep 2021 14:09:10 +0200
Subject: Save bindings on put

---
 src/com/github/ivarref/yoltq/impl.clj | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 6a4f105..cb99b08 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -20,15 +20,21 @@
    #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}])
 
 
-(defn put [config queue-name payload]
+(defn put [{:keys [capture-bindings] :as config}
+           queue-name payload]
   (if-let [_ (get-in config [:handlers queue-name])]
-    (let [id (u/squuid)]
+    (let [id (u/squuid)
+          str-bindings (->> (reduce (fn [o k]
+                                      (assoc o (symbol k) (deref k)))
+                                    {}
+                                    (or capture-bindings []))
+                            (pr-str))]
       (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
       {:com.github.ivarref.yoltq/id         id
        :com.github.ivarref.yoltq/queue-name queue-name
        :com.github.ivarref.yoltq/status     u/status-init
        :com.github.ivarref.yoltq/payload    (pr-str payload)
-       :com.github.ivarref.yoltq/bindings   (pr-str {})
+       :com.github.ivarref.yoltq/bindings   str-bindings
        :com.github.ivarref.yoltq/lock       (u/random-uuid)
        :com.github.ivarref.yoltq/tries      0
        :com.github.ivarref.yoltq/init-time  (u/now-ns)})
-- 
cgit v1.2.3


From ad8a41bd7d9e6fed77f633a75ef36410b7afbef1 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 17 Sep 2021 14:25:08 +0200
Subject: Start add bindings ...

---
 src/com/github/ivarref/yoltq.clj               | 10 +++--
 src/com/github/ivarref/yoltq/poller.clj        | 12 ++++--
 src/com/github/ivarref/yoltq/report_queue.clj  | 11 ++---
 src/com/github/ivarref/yoltq/utils.clj         | 58 ++++++++++++++++----------
 src/com/github/ivarref/yoltq/virtual_queue.clj | 23 +++++-----
 test/com/github/ivarref/yoltq/virtual_test.clj | 32 +++++++++++++-
 6 files changed, 98 insertions(+), 48 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index d3eefef..6341e41 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -58,6 +58,8 @@
        ; contain the stacktrace of the stuck threads.
        :pool-size                     4
 
+       :capture-bindings                      []
+
        ; How often should the system be polled for failed queue jobs
        :system-error-poll-delay       (Duration/ofMinutes 1)
 
@@ -159,17 +161,17 @@
       (d/create-database uri)
       (let [ok-items (atom [])
             conn (d/connect uri)
-            n 100]
+            n 1]
         (init! {:conn               conn
                 :error-backoff-time (Duration/ofSeconds 1)
                 :poll-delay         (Duration/ofSeconds 1)})
         (add-consumer! :q (fn [payload]
-                            (when (> (Math/random) 0.5)
-                              (throw (ex-info "oops" {})))
+                            #_(when (> (Math/random) 0.5)
+                                (throw (ex-info "oops" {})))
                             (if (= n (count (swap! received conj (:work payload))))
                               (log/info "... and we are done!")
                               (log/info "got payload" payload "total ok:" (count @received)))))
         (start!)
         (dotimes [x n]
-          @(d/transact conn [(put :q {:work x})]))
+          @(d/transact conn [(put :q {:work 123})]))
         nil))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/poller.clj b/src/com/github/ivarref/yoltq/poller.clj
index ad9d32a..1f4e65d 100644
--- a/src/com/github/ivarref/yoltq/poller.clj
+++ b/src/com/github/ivarref/yoltq/poller.clj
@@ -5,10 +5,14 @@
 
 
 (defn poll-once! [cfg q status]
-  (case status
-    :init (some->> (u/get-init cfg q) (i/take! cfg) (i/execute! cfg))
-    :error (some->> (u/get-error cfg q) (i/take! cfg) (i/execute! cfg))
-    :hung (some->> (u/get-hung cfg q) (i/take! cfg) (i/execute! cfg))))
+  (when-let [item (case status
+                    :init (u/get-init cfg q)
+                    :error (u/get-error cfg q)
+                    :hung (u/get-hung cfg q))]
+    (with-bindings (get item :bindings {})
+      (some->> item
+               (i/take! cfg)
+               (i/execute! cfg)))))
 
 
 (defn poll-queue! [running?
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index a40d29a..c6559bf 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -19,11 +19,12 @@
       (doseq [id new-ids]
         (consumer (fn []
                     (try
-                      (let [{:com.github.ivarref.yoltq/keys [lock id status queue-name]} (u/get-queue-item db-after id)]
-                        (some->>
-                          (u/prepare-processing id queue-name lock status)
-                          (i/take! cfg)
-                          (i/execute! cfg)))
+                      (let [{:com.github.ivarref.yoltq/keys [lock id status queue-name bindings]} (u/get-queue-item db-after id)]
+                        (with-bindings (or bindings {})
+                          (some->>
+                            (u/prepare-processing db-after id queue-name lock status)
+                            (i/take! cfg)
+                            (i/execute! cfg))))
                       (catch Throwable t
                         (log/error t "unexpected error in process-poll-result!")))))))))
 
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index c96d1dc..9501343 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -56,14 +56,22 @@
   (-> (d/pull db '[:*] [:com.github.ivarref.yoltq/id id])
       (dissoc :db/id)
       (update :com.github.ivarref.yoltq/payload edn/read-string)
-      (update :com.github.ivarref.yoltq/bindings edn/read-string)))
+      (update :com.github.ivarref.yoltq/bindings
+              (fn [s]
+                (when s
+                  (->> s
+                       (edn/read-string)
+                       (reduce-kv (fn [o k v]
+                                    (assoc o (resolve k) v))
+                                  {})))))))
 
 
-(defn prepare-processing [id queue-name old-lock old-status]
+(defn prepare-processing [db id queue-name old-lock old-status]
   (let [new-lock (random-uuid)]
     {:id         id
      :lock       new-lock
      :queue-name queue-name
+     :bindings   (get (get-queue-item db id) :com.github.ivarref.yoltq/bindings {})
      :tx         [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
                   [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status old-status status-processing]
                   {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/processing-time (now-ns)}]}))
@@ -73,29 +81,31 @@
   (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
-  (if-let [ids (->> (d/q '[:find ?id ?lock
-                           :in $ ?queue-name ?backoff
-                           :where
-                           [?e :com.github.ivarref.yoltq/status :init]
-                           [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
-                           [?e :com.github.ivarref.yoltq/init-time ?init-time]
-                           [(>= ?backoff ?init-time)]
-                           [?e :com.github.ivarref.yoltq/id ?id]
-                           [?e :com.github.ivarref.yoltq/lock ?lock]]
-                         (or db (d/db conn))
-                         queue-name
-                         (- (now-ns) init-backoff-time))
-                    (not-empty))]
-    (let [[id old-lock] (rand-nth (into [] ids))]
-      (prepare-processing id queue-name old-lock :init))
-    (log/trace "no new-items in :init status for queue" queue-name)))
+  (let [db (or db (d/db conn))]
+    (if-let [ids (->> (d/q '[:find ?id ?lock
+                             :in $ ?queue-name ?backoff
+                             :where
+                             [?e :com.github.ivarref.yoltq/status :init]
+                             [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
+                             [?e :com.github.ivarref.yoltq/init-time ?init-time]
+                             [(>= ?backoff ?init-time)]
+                             [?e :com.github.ivarref.yoltq/id ?id]
+                             [?e :com.github.ivarref.yoltq/lock ?lock]]
+                           db
+                           queue-name
+                           (- (now-ns) init-backoff-time))
+                      (not-empty))]
+      (let [[id old-lock] (rand-nth (into [] ids))]
+        (prepare-processing db id queue-name old-lock :init))
+      (log/trace "no new-items in :init status for queue" queue-name))))
 
 
 (defn get-error [{:keys [conn db error-backoff-time max-retries] :as cfg} queue-name]
   (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
-  (let [max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
+  (let [db (or db (d/db conn))
+        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
     (when-let [ids (->> (d/q '[:find ?id ?lock
                                :in $ ?queue-name ?backoff ?max-tries
                                :where
@@ -107,13 +117,13 @@
                                [(> ?max-tries ?tries)]
                                [?e :com.github.ivarref.yoltq/id ?id]
                                [?e :com.github.ivarref.yoltq/lock ?lock]]
-                             (or db (d/db conn))
+                             db
                              queue-name
                              (- (now-ns) error-backoff-time)
                              (inc max-retries))
                         (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
-        (prepare-processing id queue-name old-lock :error)))))
+        (prepare-processing db id queue-name old-lock :error)))))
 
 
 (defn get-hung [{:keys [conn db now hung-backoff-time max-retries] :as cfg} queue-name]
@@ -121,7 +131,8 @@
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
   (let [now (or now (now-ns))
-        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
+        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)
+        db (or db (d/db conn))]
     (when-let [ids (->> (d/q '[:find ?id ?lock ?tries
                                :in $ ?qname ?backoff
                                :where
@@ -132,7 +143,7 @@
                                [?e :com.github.ivarref.yoltq/tries ?tries]
                                [?e :com.github.ivarref.yoltq/id ?id]
                                [?e :com.github.ivarref.yoltq/lock ?lock]]
-                             (or db (d/db conn))
+                             db
                              queue-name
                              (- now hung-backoff-time))
                         (not-empty))]
@@ -144,6 +155,7 @@
          :queue-name queue-name
          :was-hung?  true
          :to-error?  to-error?
+         :bindings   (get (get-queue-item db id) :com.github.ivarref.yoltq/bindings {})
          :tx         (if (not to-error?)
                        [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
                         [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
diff --git a/src/com/github/ivarref/yoltq/virtual_queue.clj b/src/com/github/ivarref/yoltq/virtual_queue.clj
index f133bde..71c7b6d 100644
--- a/src/com/github/ivarref/yoltq/virtual_queue.clj
+++ b/src/com/github/ivarref/yoltq/virtual_queue.clj
@@ -146,17 +146,18 @@
 (defmacro consume-expect! [queue-name expected-status]
   `(if-let [job# (get-tx-q-job ~queue-name)]
      (try
-       (let [res# (some->>
-                    (u/prepare-processing (:com.github.ivarref.yoltq/id job#)
-                                          ~queue-name
-                                          (:com.github.ivarref.yoltq/lock job#)
-                                          (:com.github.ivarref.yoltq/status job#))
-                    (i/take! @yq/*config*)
-                    (i/execute! @yq/*config*))]
-         (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
-         (if (:retval res#)
-           (:retval res#)
-           (:exception res#)))
+       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
+         (let [res# (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
+                                                   (:com.github.ivarref.yoltq/id job#)
+                                                   ~queue-name
+                                                   (:com.github.ivarref.yoltq/lock job#)
+                                                   (:com.github.ivarref.yoltq/status job#))
+                             (i/take! @yq/*config*)
+                             (i/execute! @yq/*config*))]
+           (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
+           (if (:retval res#)
+             (:retval res#)
+             (:exception res#))))
        (catch Throwable t#
          (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
      (test/is nil (str "No job found for queue " ~queue-name))))
\ No newline at end of file
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 41d2461..575dc1b 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -8,7 +8,9 @@
             [com.github.ivarref.yoltq.utils :as uu]
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.impl :as i]
-            [com.github.ivarref.yoltq :as yq]))
+            [com.github.ivarref.yoltq :as yq]
+            [clojure.pprint :as pprint]
+            [clojure.edn :as edn]))
 
 
 (use-fixtures :each vq/call-with-virtual-queue!)
@@ -230,3 +232,31 @@
     (is (nil? (uu/get-error (assoc-in @dq/*config* [:handlers :q :max-retries] 1) :q)))))
 
 
+(deftest consume-expect-test
+  (let [conn (u/empty-conn)
+        seen (atom #{})]
+    (dq/init! {:conn conn})
+    (dq/add-consumer! :q (fn [payload]
+                           (when (= #{1 2} (swap! seen conj payload))
+                             (throw (ex-info "oops" {})))
+                           payload))
+
+    @(d/transact conn [(dq/put :q 1)])
+    @(d/transact conn [(dq/put :q 2)])
+
+    (is (= 1 (vq/consume-expect! :q :done)))
+    (vq/consume-expect! :q :error)))
+
+
+(def ^:dynamic *some-binding* nil)
+
+
+(deftest binding-test
+  (let [conn (u/empty-conn)]
+    (dq/init! {:conn conn
+               :bindings [#'*some-binding*]})
+    (dq/add-consumer! :q (fn [_] *some-binding*))
+    (binding [*some-binding* 1] @(d/transact conn [(dq/put :q nil)]))
+    #_(binding [*some-binding* 2] @(d/transact conn [(dq/put :q nil)]))
+    #_@(d/transact conn [(dq/put :q nil)])
+    (is (= 1 (vq/consume-expect! :q :done)))))
-- 
cgit v1.2.3


From d13b0cb0b72a9cef9f8e9bd82616899796a4853f Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 17 Sep 2021 14:51:01 +0200
Subject: Use [#'taoensso.timbre/*context*] as default :capture-bindings if
 present

---
 README.md                                      | 10 +++++++---
 deps.edn                                       |  3 ++-
 src/com/github/ivarref/yoltq.clj               |  7 ++++---
 test/com/github/ivarref/yoltq/log_init.clj     |  3 +++
 test/com/github/ivarref/yoltq/virtual_test.clj | 24 ++++++++++++++++++------
 5 files changed, 34 insertions(+), 13 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 514c4a3..902be2f 100644
--- a/README.md
+++ b/README.md
@@ -115,7 +115,7 @@ Inspecting `(yq/put :q {:work 123})]` you will see something like this:
                            :queue-name :q, ; Destination queue                                 
                            :status :init, ; Status
                            :payload "{:work 123}", ; Payload persisted to the database with pr-str
-                           :bindings "{}", 
+                           :bindings "{}", ; Bindings that will be applied before executing consumer function
                            :lock #uuid"037d7da1-5158-4243-8f72-feb1e47e15ca", ; Lock to protect from multiple consumers
                            :tries 0, ; How many times the job has been executed
                            :init-time 4305758012289 ; Time of initialization (System/nanoTime)
@@ -153,7 +153,7 @@ The `payload` will be deserialized from the database using `clojure.edn/read-str
 you will get back what you put into `yq/put`.
 
 The yoltq system treats a queue consumer function invocation as successful if it does not throw an exception.
-Thus any regular return value, be it `nil`, `false`, `true`, etc. is considered a success.
+Any return value, be it `nil`, `false`, `true`, etc. is considered a success.
 
 ### Listening for queue jobs
 
@@ -166,7 +166,7 @@ and process newly created queue jobs fairly quickly.
 This also means that queue jobs in status `:init` will almost always be processed without
 any type of backoff*.
 
-This pool also schedules polling jobs that will regularly check for various statuses:
+The threadpool also schedules polling jobs that will check for various statuses regularly:
 
 * Jobs in status `:error` that have waited for at least `:error-backoff-time` (default: 5 seconds) will be retried.
 * Jobs that have been in `:processing` for at least `:hung-backoff-time` (default: 30 minutes) will be considered hung and retried.
@@ -212,6 +212,10 @@ A queue job will remain in status `:error` once `:max-retries` (default: 100) ha
 Ideally this will not happen.
 
 
+### Logging
+
+
+
 ### Total health and system sanity
 
 
diff --git a/deps.edn b/deps.edn
index cf8297c..a457628 100644
--- a/deps.edn
+++ b/deps.edn
@@ -3,7 +3,8 @@
 
  :paths     ["src"]
 
- :aliases   {:test    {:extra-paths ["test"]
+ :aliases   {:datomic {:extra-deps  {com.datomic/datomic-pro {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}}}
+             :test    {:extra-paths ["test"]
                        :extra-deps  {ivarref/datomic-schema                  {:mvn/version "0.2.0"}
                                      com.taoensso/timbre                     {:mvn/version "5.1.2"}
                                      com.fzakaria/slf4j-timbre               {:mvn/version "0.3.21"}
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 6341e41..58efca1 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -1,6 +1,5 @@
 (ns com.github.ivarref.yoltq
-  (:require [datomic-schema.core]
-            [datomic.api :as d]
+  (:require [datomic.api :as d]
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.impl :as i]
             [com.github.ivarref.yoltq.report-queue :as rq]
@@ -58,7 +57,9 @@
        ; contain the stacktrace of the stuck threads.
        :pool-size                     4
 
-       :capture-bindings                      []
+       :capture-bindings              (if-let [s (resolve (symbol "taoensso.timbre/*context*"))]
+                                        [s]
+                                        [])
 
        ; How often should the system be polled for failed queue jobs
        :system-error-poll-delay       (Duration/ofMinutes 1)
diff --git a/test/com/github/ivarref/yoltq/log_init.clj b/test/com/github/ivarref/yoltq/log_init.clj
index cf69e55..1aa6c02 100644
--- a/test/com/github/ivarref/yoltq/log_init.clj
+++ b/test/com/github/ivarref/yoltq/log_init.clj
@@ -39,6 +39,9 @@
                   " "
                   (color-f (min-length 5 (str/upper-case (name level))))
                   " "
+
+                  (when-let [x-req-id (:x-request-id context)]
+                    (str "[" x-req-id "] "))
                   #_(.getName ^Thread (Thread/currentThread))
 
                   (color-f (force msg_))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index e2ea19b..3c7c5b4 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -9,8 +9,7 @@
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.impl :as i]
             [com.github.ivarref.yoltq :as yq]
-            [clojure.pprint :as pprint]
-            [clojure.edn :as edn]))
+            [taoensso.timbre :as timbre]))
 
 
 (use-fixtures :each vq/call-with-virtual-queue!)
@@ -254,11 +253,24 @@
 (deftest binding-test
   (let [conn (u/empty-conn)]
     (dq/init! {:conn conn
-               :capture-bindings [#'*some-binding*]})
+               :capture-bindings [#'*some-binding* #'timbre/*context*]})
     (dq/add-consumer! :q (fn [_] *some-binding*))
-    (binding [*some-binding* 1] @(d/transact conn [(dq/put :q nil)]))
-    (binding [*some-binding* 2] @(d/transact conn [(dq/put :q nil)]))
-    @(d/transact conn [(dq/put :q nil)])
+    (binding [timbre/*context* {:x-request-id "wooho"}]
+      (binding [*some-binding* 1]
+        @(d/transact conn [(dq/put :q nil)]))
+      (binding [*some-binding* 2]
+        @(d/transact conn [(dq/put :q nil)]))
+      @(d/transact conn [(dq/put :q nil)]))
+
     (is (= 1 (vq/consume-expect! :q :done)))
     (is (= 2 (vq/consume-expect! :q :done)))
     (is (nil? (vq/consume-expect! :q :done)))))
+
+
+(deftest default-binding-test
+  (let [conn (u/empty-conn)]
+    (dq/init! {:conn conn})
+    (dq/add-consumer! :q (fn [_] (:x-request-id timbre/*context*)))
+    (binding [timbre/*context* {:x-request-id "123"}]
+      @(d/transact conn [(dq/put :q nil)]))
+    (is (= "123" (vq/consume-expect! :q :done)))))
-- 
cgit v1.2.3


From 2a236e6d90410821370761434fad45b13621fbdf Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 17 Sep 2021 22:16:14 +0200
Subject: Add consume-twice! test function for verifying idempotence

---
 README.md                                      | 76 ++++++++++++++++++++++++--
 src/com/github/ivarref/yoltq/virtual_queue.clj | 37 ++++++++++++-
 test/com/github/ivarref/yoltq/virtual_test.clj | 11 +++-
 3 files changed, 117 insertions(+), 7 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 902be2f..29b6a62 100644
--- a/README.md
+++ b/README.md
@@ -164,13 +164,13 @@ One thread is permanently allocated for listening to the
 and responding to changes. This means that yoltq will respond 
 and process newly created queue jobs fairly quickly.
 This also means that queue jobs in status `:init` will almost always be processed without
-any type of backoff*.
+any type of backoff.
 
 The threadpool also schedules polling jobs that will check for various statuses regularly:
 
 * Jobs in status `:error` that have waited for at least `:error-backoff-time` (default: 5 seconds) will be retried.
 * Jobs that have been in `:processing` for at least `:hung-backoff-time` (default: 30 minutes) will be considered hung and retried.
-* Old `:init-backoff-time` (default: 1 minute) `:init` jobs that have not been processed. *Queue jobs can be left in status `:init` during application restart/upgrade, and thus the need for this strategy.
+* Old `:init-backoff-time` (default: 1 minute) `:init` jobs that have not been processed. Queue jobs can be left in status `:init` during application restart/upgrade, and thus the need for this strategy.
 
 
 ### Retry and backoff strategy
@@ -212,15 +212,66 @@ A queue job will remain in status `:error` once `:max-retries` (default: 100) ha
 Ideally this will not happen.
 
 
-### Logging
+# Regular and REPL usage
 
+For a regular system and/or REPL session you'll want to do:
 
+```clojure
+(require '[com.github.ivarref.yoltq :as yq])
 
-### Total health and system sanity
+(yq/init! {:conn conn})
+
+(yq/add-consumer! :q-one ...)
+(yq/add-consumer! :q-two ...)
+
+; Start yoltq system
+(yq/start!)
+
+; Oops I need another consumer. This works fine:
+(yq/add-consumer! :q-three ...)
+```
+
+You may invoke `yq/add-consumer!` and `yq/init!` on a live system as you like.
+If you change `:pool-size` or `:poll-delay` you will have to `(yq/stop!)` and
+`(yq/start!)` to make changes take effect.
 
+# Testing
 
+For testing you will probably want determinism over an extra threadpool
+by enabling the virtual queue:
+
+```clojure
+...
+(:require [clojure.test :refer :all]
+          [com.github.ivarref.yoltq :as yq]
+          [com.github.ivarref.yoltq.virtual-queue :as vq])
+
+; Enables the virtual queue and disables the threadpool for each test.
+; yq/start! and yq/stop! becomes a no-op.
+(use-fixtures :each vq/call-with-virtual-queue!)
+
+(deftest demo
+  (let [conn ...]
+    (dq/init! {:conn conn}) ; Setup
+    (dq/add-consumer! :q identity)
+    
+    @(d/transact conn [(yq/put :q {:work 123})]) ; Add work
+    
+    ; vq/consume! consumes one job and asserts that it succeeds.
+    ; It returns the return value of the consumer function
+    (is (= {:work 123} (vq/consume! :q)))))
+```
+
+
+## Other features and notes
+
+
+### Logging
+
+
+
+### Total health and system sanity
 
-## Misc
 
 ### Ordering
 
@@ -228,3 +279,18 @@ There is no attempt at ordering the execution of queue jobs.
 In fact the opposite is done to guard against the case that a single failing queue job
 could effectively take down the entire retry polling job.
 
+
+## License
+
+Copyright © 2021 Ivar Refsdal
+
+This program and the accompanying materials are made available under the
+terms of the Eclipse Public License 2.0 which is available at
+http://www.eclipse.org/legal/epl-2.0.
+
+This Source Code may also be made available under the following Secondary
+Licenses when the conditions for such availability set forth in the Eclipse
+Public License, v. 2.0 are satisfied: GNU General Public License as published by
+the Free Software Foundation, either version 2 of the License, or (at your
+option) any later version, with the GNU Classpath Exception which is available
+at https://www.gnu.org/software/classpath/license.html.
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/virtual_queue.clj b/src/com/github/ivarref/yoltq/virtual_queue.clj
index 71c7b6d..db429a8 100644
--- a/src/com/github/ivarref/yoltq/virtual_queue.clj
+++ b/src/com/github/ivarref/yoltq/virtual_queue.clj
@@ -160,4 +160,39 @@
              (:exception res#))))
        (catch Throwable t#
          (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
-     (test/is nil (str "No job found for queue " ~queue-name))))
\ No newline at end of file
+     (test/is false (str "No job found for queue " ~queue-name))))
+tx-spent-time!
+
+(defmacro consume! [queue-name]
+  `(consume-expect! ~queue-name :done))
+
+
+(defn mark-fails! [{:keys [conn]}
+                   {:com.github.ivarref.yoltq/keys [id lock tries]}
+                   _]
+  (try
+    (let [tx [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock lock (u/random-uuid)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing :init]]]
+      @(d/transact conn tx)
+      nil)
+    (catch Throwable t
+      (log/error t "unexpected error in mark-status!: " (ex-message t))
+      nil)))
+
+
+(defmacro consume-twice! [queue-name]
+  `(if-let [job# (get-tx-q-job ~queue-name)]
+     (try
+       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
+         (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
+                                        (:com.github.ivarref.yoltq/id job#)
+                                        ~queue-name
+                                        (:com.github.ivarref.yoltq/lock job#)
+                                        (:com.github.ivarref.yoltq/status job#))
+                  (i/take! @yq/*config*)
+                  (i/execute! (assoc @yq/*config* :mark-status-fn! mark-fails!)))
+         (consume! ~queue-name))
+       (catch Throwable t#
+         (log/error t# "unexpected error in consume-twice!:" (ex-message t#))))
+     (test/is false (str "No job found for queue " ~queue-name))))
\ No newline at end of file
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 3c7c5b4..5e5fc92 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -20,7 +20,7 @@
     (dq/init! {:conn conn})
     (dq/add-consumer! :q identity)
     @(d/transact conn [(dq/put :q {:work 123})])
-    (is (= {:work 123} (:retval (vq/run-queue-once! :q :init))))))
+    (is (= {:work 123} (vq/consume! :q)))))
 
 
 (deftest happy-case-tx-report-q
@@ -274,3 +274,12 @@
     (binding [timbre/*context* {:x-request-id "123"}]
       @(d/transact conn [(dq/put :q nil)]))
     (is (= "123" (vq/consume-expect! :q :done)))))
+
+
+(deftest consume-twice
+  (let [conn (u/empty-conn)
+        cnt (atom 0)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [_] (swap! cnt inc)))
+    @(d/transact conn [(dq/put :q nil)])
+    (is (= 2 (vq/consume-twice! :q)))))
-- 
cgit v1.2.3


From 60f7371f4d2dd43c5b177039406eeaab00ba27cc Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Thu, 23 Sep 2021 11:06:33 +0200
Subject: To test-queue namespace

---
 README.md                                      |  24 +--
 src/com/github/ivarref/yoltq/test_queue.clj    | 197 ++++++++++++++++++++++++
 src/com/github/ivarref/yoltq/virtual_queue.clj | 198 -------------------------
 test/com/github/ivarref/yoltq/test_utils.clj   |  16 +-
 test/com/github/ivarref/yoltq/virtual_test.clj | 140 ++++++++---------
 5 files changed, 287 insertions(+), 288 deletions(-)
 create mode 100644 src/com/github/ivarref/yoltq/test_queue.clj
 delete mode 100644 src/com/github/ivarref/yoltq/virtual_queue.clj

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 29b6a62..84dc91b 100644
--- a/README.md
+++ b/README.md
@@ -243,23 +243,23 @@ by enabling the virtual queue:
 ```clojure
 ...
 (:require [clojure.test :refer :all]
-          [com.github.ivarref.yoltq :as yq]
-          [com.github.ivarref.yoltq.virtual-queue :as vq])
+  [com.github.ivarref.yoltq :as yq]
+  [com.github.ivarref.yoltq.test-queue :as tq])
 
 ; Enables the virtual queue and disables the threadpool for each test.
 ; yq/start! and yq/stop! becomes a no-op.
-(use-fixtures :each vq/call-with-virtual-queue!)
+(use-fixtures :each tq/call-with-virtual-queue!)
 
 (deftest demo
-  (let [conn ...]
-    (dq/init! {:conn conn}) ; Setup
-    (dq/add-consumer! :q identity)
-    
-    @(d/transact conn [(yq/put :q {:work 123})]) ; Add work
-    
-    ; vq/consume! consumes one job and asserts that it succeeds.
-    ; It returns the return value of the consumer function
-    (is (= {:work 123} (vq/consume! :q)))))
+         (let [conn ...]
+           (yq/init! {:conn conn}) ; Setup
+           (yq/add-consumer! :q identity)
+
+           @(d/transact conn [(yq/put :q {:work 123})]) ; Add work
+
+           ; tq/consume! consumes one job and asserts that it succeeds.
+           ; It returns the return value of the consumer function
+           (is (= {:work 123} (tq/consume! :q)))))
 ```
 
 
diff --git a/src/com/github/ivarref/yoltq/test_queue.clj b/src/com/github/ivarref/yoltq/test_queue.clj
new file mode 100644
index 0000000..6aeb959
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/test_queue.clj
@@ -0,0 +1,197 @@
+(ns com.github.ivarref.yoltq.test-queue
+  (:require [clojure.tools.logging :as log]
+            [com.github.ivarref.yoltq.report-queue :as rq]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [com.github.ivarref.yoltq :as yq]
+            [datomic.api :as d]
+            [com.github.ivarref.yoltq.poller :as poller]
+            [clojure.test :as test]
+            [com.github.ivarref.yoltq.utils :as u]
+            [com.github.ivarref.yoltq.impl :as i])
+  (:import (java.util.concurrent BlockingQueue TimeUnit)
+           (datomic Datom)))
+
+
+(defn bootstrap-poller! [txq running? poller-exited? bootstrapped? conn]
+  (let [ready? (promise)]
+    (future
+      (let [q (d/tx-report-queue conn)]
+        (try
+          (while @running?
+            (when-let [poll-result (.poll ^BlockingQueue q 10 TimeUnit/MILLISECONDS)]
+              (swap! txq conj poll-result))
+            (deliver ready? true)
+            (reset! bootstrapped? true))
+          (catch Throwable t
+            (log/error t "test-poller crashed: " (ex-message t)))
+          (finally
+            (try
+              (d/remove-tx-report-queue conn)
+              (catch Throwable t
+                (log/warn t "remove-tx-report-queue failed:" (ex-message t))))
+            (deliver poller-exited? true)))))
+    @ready?))
+
+
+(defmacro with-virtual-queue!
+  [& body]
+  `(let [txq# (atom [])
+         poller-exited?# (promise)
+         bootstrapped?# (atom false)
+         running?# (atom true)
+         config# (atom {:bootstrap-poller! (partial bootstrap-poller! txq# running?# poller-exited?# bootstrapped?#)
+                        :init-backoff-time 0
+                        :hung-log-level    :warn
+                        :tx-queue          txq#})]
+     (with-bindings {#'yq/*config*       config#
+                     #'yq/*running?*     (atom false)
+                     #'yq/*test-mode*    true
+                     #'ext/*now-ns-atom* (atom 0)
+                     #'ext/*random-atom* (atom 0)
+                     #'ext/*squuid-atom* (atom 0)}
+       (try
+         ~@body
+         (finally
+           (reset! running?# false)
+           (when @bootstrapped?#
+             @poller-exited?#))))))
+
+
+(defn call-with-virtual-queue!
+  [f]
+  (with-virtual-queue!
+    (f)))
+
+
+(defn run-report-queue! [min-items]
+  (let [{:keys [tx-queue conn]} @yq/*config*
+        id-ident (d/q '[:find ?e .
+                        :where [?e :db/ident :com.github.ivarref.yoltq/id]]
+                      (d/db conn))]
+    (let [timeout (+ 3000 (System/currentTimeMillis))]
+      (while (and (< (System/currentTimeMillis) timeout)
+                  (< (count @tx-queue) min-items))
+        (Thread/sleep 10)))
+    (when (< (count @tx-queue) min-items)
+      (let [msg (str "run-report-queue: timeout waiting for " min-items " items")]
+        (log/error msg)
+        (throw (ex-info msg {}))))
+    (let [res (atom [])]
+      (doseq [itm (first (swap-vals! tx-queue (constantly [])))]
+        (rq/process-poll-result!
+          @yq/*config*
+          id-ident
+          itm
+          (fn [f] (swap! res conj (f)))))
+      @res)))
+
+
+(defn run-one-report-queue! []
+  (first (run-report-queue! 1)))
+
+
+(defn run-queue-once! [q status]
+  (poller/poll-once! @yq/*config* q status))
+
+
+(defn put! [q payload]
+  @(d/transact (:conn @yq/*config*) [(yq/put q payload)]))
+
+
+(defn transact-result->maps [{:keys [tx-data db-after]}]
+  (let [m (->> tx-data
+               (group-by (fn [^Datom d] (.e d)))
+               (vals)
+               (mapv (fn [datoms]
+                       (reduce (fn [o ^Datom d]
+                                 (if (.added d)
+                                   (assoc o (d/q '[:find ?r .
+                                                   :in $ ?e
+                                                   :where [?e :db/ident ?r]]
+                                                 db-after
+                                                 (.a d))
+                                            (.v d))
+                                   o))
+                               {}
+                               datoms))))]
+    m))
+
+(defn contains-queue-job?
+  [queue-id conn {::yq/keys [id queue-name status] :as m}]
+  (when (and (= queue-id queue-name)
+             (= status :init)
+             (d/q '[:find ?e .
+                    :in $ ?id
+                    :where
+                    [?e ::yq/id ?id]
+                    [?e ::yq/status :init]]
+                  (d/db conn)
+                  id))
+    m))
+
+
+(defn get-tx-q-job [q-id]
+  (let [{:keys [tx-queue conn]} @yq/*config*]
+    (loop [timeout (+ 3000 (System/currentTimeMillis))]
+      (if-let [job (->> @tx-queue
+                        (mapcat transact-result->maps)
+                        (filter (partial contains-queue-job? q-id conn))
+                        (first))]
+        (u/get-queue-item (d/db conn) (::yq/id job))
+        (if (< (System/currentTimeMillis) timeout)
+          (do (Thread/sleep 10)
+              (recur timeout))
+          nil)))))
+
+(defmacro consume-expect! [queue-name expected-status]
+  `(if-let [job# (get-tx-q-job ~queue-name)]
+     (try
+       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
+         (let [res# (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
+                                                   (:com.github.ivarref.yoltq/id job#)
+                                                   ~queue-name
+                                                   (:com.github.ivarref.yoltq/lock job#)
+                                                   (:com.github.ivarref.yoltq/status job#))
+                             (i/take! @yq/*config*)
+                             (i/execute! @yq/*config*))]
+           (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
+           (if (:retval res#)
+             (:retval res#)
+             (:exception res#))))
+       (catch Throwable t#
+         (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
+     (test/is false (str "No job found for queue " ~queue-name))))
+
+(defmacro consume! [queue-name]
+  `(consume-expect! ~queue-name :done))
+
+
+(defn mark-fails! [{:keys [conn]}
+                   {:com.github.ivarref.yoltq/keys [id lock tries]}
+                   _]
+  (try
+    (let [tx [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock lock (u/random-uuid)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
+              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing :init]]]
+      @(d/transact conn tx)
+      nil)
+    (catch Throwable t
+      (log/error t "unexpected error in mark-status!: " (ex-message t))
+      nil)))
+
+
+(defmacro force-retry! [queue-name]
+  `(if-let [job# (get-tx-q-job ~queue-name)]
+     (try
+       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
+         (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
+                                        (:com.github.ivarref.yoltq/id job#)
+                                        ~queue-name
+                                        (:com.github.ivarref.yoltq/lock job#)
+                                        (:com.github.ivarref.yoltq/status job#))
+                  (i/take! @yq/*config*)
+                  (i/execute! (assoc @yq/*config* :mark-status-fn! mark-fails!)))
+         (consume! ~queue-name))
+       (catch Throwable t#
+         (log/error t# "unexpected error in consume-twice!:" (ex-message t#))))
+     (test/is false (str "No job found for queue " ~queue-name))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/virtual_queue.clj b/src/com/github/ivarref/yoltq/virtual_queue.clj
deleted file mode 100644
index db429a8..0000000
--- a/src/com/github/ivarref/yoltq/virtual_queue.clj
+++ /dev/null
@@ -1,198 +0,0 @@
-(ns com.github.ivarref.yoltq.virtual-queue
-  (:require [clojure.tools.logging :as log]
-            [com.github.ivarref.yoltq.report-queue :as rq]
-            [com.github.ivarref.yoltq.ext-sys :as ext]
-            [com.github.ivarref.yoltq :as yq]
-            [datomic.api :as d]
-            [com.github.ivarref.yoltq.poller :as poller]
-            [clojure.test :as test]
-            [com.github.ivarref.yoltq.utils :as u]
-            [com.github.ivarref.yoltq.impl :as i])
-  (:import (java.util.concurrent BlockingQueue TimeUnit)
-           (datomic Datom)))
-
-
-(defn bootstrap-poller! [txq running? poller-exited? bootstrapped? conn]
-  (let [ready? (promise)]
-    (future
-      (let [q (d/tx-report-queue conn)]
-        (try
-          (while @running?
-            (when-let [poll-result (.poll ^BlockingQueue q 10 TimeUnit/MILLISECONDS)]
-              (swap! txq conj poll-result))
-            (deliver ready? true)
-            (reset! bootstrapped? true))
-          (catch Throwable t
-            (log/error t "test-poller crashed: " (ex-message t)))
-          (finally
-            (try
-              (d/remove-tx-report-queue conn)
-              (catch Throwable t
-                (log/warn t "remove-tx-report-queue failed:" (ex-message t))))
-            (deliver poller-exited? true)))))
-    @ready?))
-
-
-(defmacro with-virtual-queue!
-  [& body]
-  `(let [txq# (atom [])
-         poller-exited?# (promise)
-         bootstrapped?# (atom false)
-         running?# (atom true)
-         config# (atom {:bootstrap-poller! (partial bootstrap-poller! txq# running?# poller-exited?# bootstrapped?#)
-                        :init-backoff-time 0
-                        :hung-log-level    :warn
-                        :tx-queue          txq#})]
-     (with-bindings {#'yq/*config*       config#
-                     #'yq/*running?*     (atom false)
-                     #'yq/*test-mode*    true
-                     #'ext/*now-ns-atom* (atom 0)
-                     #'ext/*random-atom* (atom 0)
-                     #'ext/*squuid-atom* (atom 0)}
-       (try
-         ~@body
-         (finally
-           (reset! running?# false)
-           (when @bootstrapped?#
-             @poller-exited?#))))))
-
-
-(defn call-with-virtual-queue!
-  [f]
-  (with-virtual-queue!
-    (f)))
-
-
-(defn run-report-queue! [min-items]
-  (let [{:keys [tx-queue conn]} @yq/*config*
-        id-ident (d/q '[:find ?e .
-                        :where [?e :db/ident :com.github.ivarref.yoltq/id]]
-                      (d/db conn))]
-    (let [timeout (+ 3000 (System/currentTimeMillis))]
-      (while (and (< (System/currentTimeMillis) timeout)
-                  (< (count @tx-queue) min-items))
-        (Thread/sleep 10)))
-    (when (< (count @tx-queue) min-items)
-      (let [msg (str "run-report-queue: timeout waiting for " min-items " items")]
-        (log/error msg)
-        (throw (ex-info msg {}))))
-    (let [res (atom [])]
-      (doseq [itm (first (swap-vals! tx-queue (constantly [])))]
-        (rq/process-poll-result!
-          @yq/*config*
-          id-ident
-          itm
-          (fn [f] (swap! res conj (f)))))
-      @res)))
-
-
-(defn run-one-report-queue! []
-  (first (run-report-queue! 1)))
-
-
-(defn run-queue-once! [q status]
-  (poller/poll-once! @yq/*config* q status))
-
-
-(defn put! [q payload]
-  @(d/transact (:conn @yq/*config*) [(yq/put q payload)]))
-
-
-(defn transact-result->maps [{:keys [tx-data db-after]}]
-  (let [m (->> tx-data
-               (group-by (fn [^Datom d] (.e d)))
-               (vals)
-               (mapv (fn [datoms]
-                       (reduce (fn [o ^Datom d]
-                                 (if (.added d)
-                                   (assoc o (d/q '[:find ?r .
-                                                   :in $ ?e
-                                                   :where [?e :db/ident ?r]]
-                                                 db-after
-                                                 (.a d))
-                                            (.v d))
-                                   o))
-                               {}
-                               datoms))))]
-    m))
-
-(defn contains-queue-job?
-  [queue-id conn {::yq/keys [id queue-name status] :as m}]
-  (when (and (= queue-id queue-name)
-             (= status :init)
-             (d/q '[:find ?e .
-                    :in $ ?id
-                    :where
-                    [?e ::yq/id ?id]
-                    [?e ::yq/status :init]]
-                  (d/db conn)
-                  id))
-    m))
-
-
-(defn get-tx-q-job [q-id]
-  (let [{:keys [tx-queue conn]} @yq/*config*]
-    (loop [timeout (+ 3000 (System/currentTimeMillis))]
-      (if-let [job (->> @tx-queue
-                        (mapcat transact-result->maps)
-                        (filter (partial contains-queue-job? q-id conn))
-                        (first))]
-        (u/get-queue-item (d/db conn) (::yq/id job))
-        (if (< (System/currentTimeMillis) timeout)
-          (do (Thread/sleep 10)
-              (recur timeout))
-          nil)))))
-
-(defmacro consume-expect! [queue-name expected-status]
-  `(if-let [job# (get-tx-q-job ~queue-name)]
-     (try
-       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
-         (let [res# (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
-                                                   (:com.github.ivarref.yoltq/id job#)
-                                                   ~queue-name
-                                                   (:com.github.ivarref.yoltq/lock job#)
-                                                   (:com.github.ivarref.yoltq/status job#))
-                             (i/take! @yq/*config*)
-                             (i/execute! @yq/*config*))]
-           (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
-           (if (:retval res#)
-             (:retval res#)
-             (:exception res#))))
-       (catch Throwable t#
-         (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
-     (test/is false (str "No job found for queue " ~queue-name))))
-tx-spent-time!
-
-(defmacro consume! [queue-name]
-  `(consume-expect! ~queue-name :done))
-
-
-(defn mark-fails! [{:keys [conn]}
-                   {:com.github.ivarref.yoltq/keys [id lock tries]}
-                   _]
-  (try
-    (let [tx [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock lock (u/random-uuid)]
-              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
-              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing :init]]]
-      @(d/transact conn tx)
-      nil)
-    (catch Throwable t
-      (log/error t "unexpected error in mark-status!: " (ex-message t))
-      nil)))
-
-
-(defmacro consume-twice! [queue-name]
-  `(if-let [job# (get-tx-q-job ~queue-name)]
-     (try
-       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
-         (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
-                                        (:com.github.ivarref.yoltq/id job#)
-                                        ~queue-name
-                                        (:com.github.ivarref.yoltq/lock job#)
-                                        (:com.github.ivarref.yoltq/status job#))
-                  (i/take! @yq/*config*)
-                  (i/execute! (assoc @yq/*config* :mark-status-fn! mark-fails!)))
-         (consume! ~queue-name))
-       (catch Throwable t#
-         (log/error t# "unexpected error in consume-twice!:" (ex-message t#))))
-     (test/is false (str "No job found for queue " ~queue-name))))
\ No newline at end of file
diff --git a/test/com/github/ivarref/yoltq/test_utils.clj b/test/com/github/ivarref/yoltq/test_utils.clj
index dacba68..df56460 100644
--- a/test/com/github/ivarref/yoltq/test_utils.clj
+++ b/test/com/github/ivarref/yoltq/test_utils.clj
@@ -2,7 +2,7 @@
   (:require [com.github.ivarref.yoltq.log-init :as logconfig]
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.utils :as u]
-            [com.github.ivarref.yoltq :as dq]
+            [com.github.ivarref.yoltq :as yq]
             [datomic.api :as d]
             [clojure.string :as str]
             [com.github.ivarref.yoltq.impl :as i]
@@ -35,7 +35,7 @@
 
 
 (defn put-transact! [id payload]
-  @(d/transact (:conn @dq/*config*) [(i/put @dq/*config* id payload)]))
+  @(d/transact (:conn @yq/*config*) [(i/put @yq/*config* id payload)]))
 
 
 (defn advance! [tp]
@@ -50,25 +50,25 @@
          :where
          [?e :com.github.ivarref.yoltq/id _]
          [?e :com.github.ivarref.yoltq/status :done]]
-       (d/db (:conn @dq/*config*))))
+       (d/db (:conn @yq/*config*))))
 
 
 (defn get-init [& args]
-  (apply u/get-init @dq/*config* args))
+  (apply u/get-init @yq/*config* args))
 
 
 (defn get-error [& args]
-  (apply u/get-error @dq/*config* args))
+  (apply u/get-error @yq/*config* args))
 
 
 (defn get-hung [& args]
-  (apply u/get-hung @dq/*config* args))
+  (apply u/get-hung @yq/*config* args))
 
 
 (defn take! [& args]
-  (apply i/take! @dq/*config* args))
+  (apply i/take! @yq/*config* args))
 
 
 (defn execute! [& args]
-  (apply i/execute! @dq/*config* args))
+  (apply i/execute! @yq/*config* args))
 
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 5e5fc92..442acac 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -1,8 +1,7 @@
 (ns com.github.ivarref.yoltq.virtual-test
   (:require [datomic-schema.core]
             [clojure.test :refer :all]
-            [com.github.ivarref.yoltq.virtual-queue :as vq]
-            [com.github.ivarref.yoltq :as dq]
+            [com.github.ivarref.yoltq.test-queue :as tq]
             [com.github.ivarref.yoltq.test-utils :as u]
             [datomic.api :as d]
             [com.github.ivarref.yoltq.utils :as uu]
@@ -12,29 +11,29 @@
             [taoensso.timbre :as timbre]))
 
 
-(use-fixtures :each vq/call-with-virtual-queue!)
+(use-fixtures :each tq/call-with-virtual-queue!)
 
 
 (deftest happy-case-1
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q identity)
-    @(d/transact conn [(dq/put :q {:work 123})])
-    (is (= {:work 123} (vq/consume! :q)))))
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q identity)
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (is (= {:work 123} (tq/consume! :q)))))
 
 
 (deftest happy-case-tx-report-q
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q identity)
-    @(d/transact conn [(dq/put :q {:work 123})])
-    (is (= {:work 123} (:retval (vq/run-one-report-queue!))))
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q identity)
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (is (= {:work 123} (:retval (tq/run-one-report-queue!))))
     (is (= 1 (u/done-count)))))
 
 
 (deftest happy-case-poller
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn     conn
+    (yq/init! {:conn     conn
                :handlers {:q {:f (fn [payload] payload)}}})
     (u/put-transact! :q {:work 123})
     (u/advance! (:init-backoff-time yq/default-opts))
@@ -47,8 +46,8 @@
 (deftest happy-case-queue-fn-allow-cas-failure
   (let [conn (u/empty-conn)
         invoke-count (atom 0)]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q
                       (fn [{:keys [id]}]
                         (swap! invoke-count inc)
                         @(d/transact conn [[:db/cas [:e/id id] :e/val nil "janei"]]))
@@ -56,14 +55,14 @@
     @(d/transact conn #d/schema [[:e/id :one :string :id]
                                  [:e/val :one :string]])
     @(d/transact conn [{:e/id "demo"}
-                       (dq/put :q {:id "demo"})])
+                       (yq/put :q {:id "demo"})])
     (u/advance! (:init-backoff-time yq/default-opts))
-    (swap! dq/*config* assoc :mark-status-fn! (fn [_ _ new-status]
+    (swap! yq/*config* assoc :mark-status-fn! (fn [_ _ new-status]
                                                 (log/info "mark-status! doing nothing for new status" new-status)))
     (is (nil? (some->> (u/get-init :q)
                        (u/take!)
                        (u/execute!))))
-    (swap! dq/*config* dissoc :mark-status-fn!)
+    (swap! yq/*config* dissoc :mark-status-fn!)
 
     ; (mark-status! :done) failed but f succeeded.
     (is (nil? (u/get-hung :q)))
@@ -78,7 +77,7 @@
 
 (deftest backoff-test
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn              conn
+    (yq/init! {:conn              conn
                :init-backoff-time (:init-backoff-time yq/default-opts)
                :handlers          {:q {:f (fn [_] (throw (ex-info "janei" {})))}}})
     (u/put-transact! :q {:work 123})
@@ -102,7 +101,7 @@
 
 (deftest get-hung-test
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn              conn
+    (yq/init! {:conn              conn
                :init-backoff-time (:init-backoff-time yq/default-opts)
                :handlers          {:q {:f (fn [_] (throw (ex-info "janei" {})))}}})
     (u/put-transact! :q {:work 123})
@@ -122,7 +121,7 @@
 
 (deftest basic-locking
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn              conn
+    (yq/init! {:conn              conn
                :init-backoff-time (:init-backoff-time yq/default-opts)
                :cas-failures      (atom 0)
                :handlers          {:q {:f (fn [_] (throw (ex-info "janei" {})))}}})
@@ -133,12 +132,12 @@
     (let [job (u/get-init :q)]
       (is (= :processing (some->> job (u/take!) :com.github.ivarref.yoltq/status)))
       (u/take! job)
-      (is (= 1 @(:cas-failures @dq/*config*))))))
+      (is (= 1 @(:cas-failures @yq/*config*))))))
 
 
 (deftest retry-test
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn              conn
+    (yq/init! {:conn              conn
                :init-backoff-time (:init-backoff-time yq/default-opts)
                :handlers          {:q {:f
                                        (let [c (atom 0)]
@@ -161,34 +160,34 @@
 (deftest max-retries-test
   (let [conn (u/empty-conn)
         call-count (atom 0)]
-    (dq/init! {:conn               conn
+    (yq/init! {:conn               conn
                :error-backoff-time 0})
-    (dq/add-consumer! :q (fn [_]
+    (yq/add-consumer! :q (fn [_]
                            (swap! call-count inc)
                            (throw (ex-info "janei" {})))
                       {:max-retries 1})
-    (vq/put! :q {:work 123})
-    (is (some? (:exception (vq/run-one-report-queue!))))
+    (tq/put! :q {:work 123})
+    (is (some? (:exception (tq/run-one-report-queue!))))
 
     (dotimes [_ 10]
-      (vq/run-queue-once! :q :error))
+      (tq/run-queue-once! :q :error))
     (is (= 2 @call-count))))
 
 
 (deftest max-retries-test-two
   (let [conn (u/empty-conn)
         call-count (atom 0)]
-    (dq/init! {:conn               conn
+    (yq/init! {:conn               conn
                :error-backoff-time 0})
-    (dq/add-consumer! :q (fn [_]
+    (yq/add-consumer! :q (fn [_]
                            (swap! call-count inc)
                            (throw (ex-info "janei" {})))
                       {:max-retries 3})
-    (vq/put! :q {:work 123})
-    (is (some? (:exception (vq/run-one-report-queue!))))
+    (tq/put! :q {:work 123})
+    (is (some? (:exception (tq/run-one-report-queue!))))
 
     (dotimes [_ 20]
-      (vq/run-queue-once! :q :error))
+      (tq/run-queue-once! :q :error))
     (is (= 4 @call-count))))
 
 
@@ -196,55 +195,55 @@
   (let [conn (u/empty-conn)
         call-count (atom 0)
         missed-mark-status (atom nil)]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q
                       (fn [_]
                         (if (= 1 (swap! call-count inc))
                           (throw (ex-info "error" {}))
                           (log/info "return OK"))))
-    (vq/put! :q {:id "demo"})
-    (vq/run-one-report-queue!)                              ; now in status :error
+    (tq/put! :q {:id "demo"})
+    (tq/run-one-report-queue!)                              ; now in status :error
 
 
-    (swap! dq/*config* assoc :mark-status-fn! (fn [_ _ new-status]
+    (swap! yq/*config* assoc :mark-status-fn! (fn [_ _ new-status]
                                                 (reset! missed-mark-status new-status)
                                                 (log/info "mark-status! doing nothing for new status" new-status)))
     (u/advance! (:error-backoff-time @yq/*config*))
-    (vq/run-queue-once! :q :error)
-    (swap! dq/*config* dissoc :mark-status-fn!)
+    (tq/run-queue-once! :q :error)
+    (swap! yq/*config* dissoc :mark-status-fn!)
     (is (= :done @missed-mark-status))
 
-    (is (nil? (uu/get-hung @dq/*config* :q)))
+    (is (nil? (uu/get-hung @yq/*config* :q)))
     (u/advance! (:hung-backoff-time @yq/*config*))
 
-    (is (some? (uu/get-hung @dq/*config* :q)))
+    (is (some? (uu/get-hung @yq/*config* :q)))
 
     (is (= 2 @call-count))
 
-    (is (true? (some->> (uu/get-hung (assoc-in @dq/*config* [:handlers :q :max-retries] 1) :q)
-                        (i/take! @dq/*config*)
-                        (i/execute! @dq/*config*)
+    (is (true? (some->> (uu/get-hung (assoc-in @yq/*config* [:handlers :q :max-retries] 1) :q)
+                        (i/take! @yq/*config*)
+                        (i/execute! @yq/*config*)
                         :failed?)))
 
     (u/advance! (:error-backoff-time @yq/*config*))
-    (is (some? (uu/get-error @dq/*config* :q)))
-    (is (nil? (uu/get-error (assoc-in @dq/*config* [:handlers :q :max-retries] 1) :q)))))
+    (is (some? (uu/get-error @yq/*config* :q)))
+    (is (nil? (uu/get-error (assoc-in @yq/*config* [:handlers :q :max-retries] 1) :q)))))
 
 
 (deftest consume-expect-test
   (let [conn (u/empty-conn)
         seen (atom #{})]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q (fn [payload]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [payload]
                            (when (= #{1 2} (swap! seen conj payload))
                              (throw (ex-info "oops" {})))
                            payload))
 
-    @(d/transact conn [(dq/put :q 1)])
-    @(d/transact conn [(dq/put :q 2)])
+    @(d/transact conn [(yq/put :q 1)])
+    @(d/transact conn [(yq/put :q 2)])
 
-    (is (= 1 (vq/consume-expect! :q :done)))
-    (vq/consume-expect! :q :error)))
+    (is (= 1 (tq/consume-expect! :q :done)))
+    (tq/consume-expect! :q :error)))
 
 
 (def ^:dynamic *some-binding* nil)
@@ -252,34 +251,35 @@
 
 (deftest binding-test
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn conn
+    (yq/init! {:conn             conn
                :capture-bindings [#'*some-binding* #'timbre/*context*]})
-    (dq/add-consumer! :q (fn [_] *some-binding*))
+    (yq/add-consumer! :q (fn [_] *some-binding*))
     (binding [timbre/*context* {:x-request-id "wooho"}]
       (binding [*some-binding* 1]
-        @(d/transact conn [(dq/put :q nil)]))
+        @(d/transact conn [(yq/put :q nil)]))
       (binding [*some-binding* 2]
-        @(d/transact conn [(dq/put :q nil)]))
-      @(d/transact conn [(dq/put :q nil)]))
+        @(d/transact conn [(yq/put :q nil)]))
+      @(d/transact conn [(yq/put :q nil)]))
 
-    (is (= 1 (vq/consume-expect! :q :done)))
-    (is (= 2 (vq/consume-expect! :q :done)))
-    (is (nil? (vq/consume-expect! :q :done)))))
+    (is (= 1 (tq/consume-expect! :q :done)))
+    (is (= 2 (tq/consume-expect! :q :done)))
+    (is (nil? (tq/consume-expect! :q :done)))))
 
 
 (deftest default-binding-test
   (let [conn (u/empty-conn)]
-    (dq/init! {:conn conn})
-    (dq/add-consumer! :q (fn [_] (:x-request-id timbre/*context*)))
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [_] (:x-request-id timbre/*context*)))
     (binding [timbre/*context* {:x-request-id "123"}]
-      @(d/transact conn [(dq/put :q nil)]))
-    (is (= "123" (vq/consume-expect! :q :done)))))
+      @(d/transact conn [(yq/put :q nil)]))
+    (is (= "123" (tq/consume-expect! :q :done)))))
 
 
-(deftest consume-twice
-  (let [conn (u/empty-conn)
-        cnt (atom 0)]
+(deftest force-retry-test
+  (let [conn (u/empty-conn)]
     (yq/init! {:conn conn})
-    (yq/add-consumer! :q (fn [_] (swap! cnt inc)))
-    @(d/transact conn [(dq/put :q nil)])
-    (is (= 2 (vq/consume-twice! :q)))))
+    (yq/add-consumer! :q (let [cnt (atom 0)]
+                           (fn [_] (swap! cnt inc))))
+    @(d/transact conn [(yq/put :q nil)])
+    (is (= 1 (tq/consume! :q)))
+    #_(is (= 2 (tq/force-retry! :q)))))
-- 
cgit v1.2.3


From 79cc3f448949d755c59265e2316408d037be20cb Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Thu, 23 Sep 2021 11:30:03 +0200
Subject: Add force-retry!

---
 src/com/github/ivarref/yoltq/impl.clj          |  2 +-
 src/com/github/ivarref/yoltq/test_queue.clj    | 49 +++++++++++---------------
 test/com/github/ivarref/yoltq/virtual_test.clj |  3 +-
 3 files changed, 23 insertions(+), 31 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index cb99b08..9c95cff 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -67,7 +67,7 @@
           (cond
             (= :db.error/cas-failed error)
             (do
-              (log/info ":db.error/cas-failed for queue item" (str id) "and attribute" (:a m))
+              (log/info "take! :db.error/cas-failed for queue item" (str id) "and attribute" (:a m))
               (when cas-failures
                 (swap! cas-failures inc))
               nil)
diff --git a/src/com/github/ivarref/yoltq/test_queue.clj b/src/com/github/ivarref/yoltq/test_queue.clj
index 6aeb959..4c4f903 100644
--- a/src/com/github/ivarref/yoltq/test_queue.clj
+++ b/src/com/github/ivarref/yoltq/test_queue.clj
@@ -42,6 +42,7 @@
          config# (atom {:bootstrap-poller! (partial bootstrap-poller! txq# running?# poller-exited?# bootstrapped?#)
                         :init-backoff-time 0
                         :hung-log-level    :warn
+                        :prev-consumed     (atom {})
                         :tx-queue          txq#})]
      (with-bindings {#'yq/*config*       config#
                      #'yq/*running?*     (atom false)
@@ -154,44 +155,34 @@
                                                    (:com.github.ivarref.yoltq/status job#))
                              (i/take! @yq/*config*)
                              (i/execute! @yq/*config*))]
+           (swap! (:prev-consumed @yq/*config*) assoc ~queue-name res#)
            (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
            (if (:retval res#)
              (:retval res#)
              (:exception res#))))
        (catch Throwable t#
-         (log/error t# "unexpected error in consume-expect:" (ex-message t#))))
+         (log/error t# "unexpected error in consume-expect:" (ex-message t#))
+         (throw t#)))
      (test/is false (str "No job found for queue " ~queue-name))))
 
 (defmacro consume! [queue-name]
   `(consume-expect! ~queue-name :done))
 
 
-(defn mark-fails! [{:keys [conn]}
-                   {:com.github.ivarref.yoltq/keys [id lock tries]}
-                   _]
-  (try
-    (let [tx [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock lock (u/random-uuid)]
-              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
-              [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing :init]]]
-      @(d/transact conn tx)
-      nil)
-    (catch Throwable t
-      (log/error t "unexpected error in mark-status!: " (ex-message t))
-      nil)))
-
-
 (defmacro force-retry! [queue-name]
-  `(if-let [job# (get-tx-q-job ~queue-name)]
-     (try
-       (with-bindings (:com.github.ivarref.yoltq/bindings job#)
-         (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
-                                        (:com.github.ivarref.yoltq/id job#)
-                                        ~queue-name
-                                        (:com.github.ivarref.yoltq/lock job#)
-                                        (:com.github.ivarref.yoltq/status job#))
-                  (i/take! @yq/*config*)
-                  (i/execute! (assoc @yq/*config* :mark-status-fn! mark-fails!)))
-         (consume! ~queue-name))
-       (catch Throwable t#
-         (log/error t# "unexpected error in consume-twice!:" (ex-message t#))))
-     (test/is false (str "No job found for queue " ~queue-name))))
\ No newline at end of file
+  `(if-let [job# (some-> @yq/*config* :prev-consumed deref (get ~queue-name))]
+     (let [db-res# @(d/transact (:conn @yq/*config*) [{:com.github.ivarref.yoltq/id     (:com.github.ivarref.yoltq/id job#)
+                                                       :com.github.ivarref.yoltq/status :init}])
+           res# (some->> (u/prepare-processing (:db-after db-res#)
+                                               (:com.github.ivarref.yoltq/id job#)
+                                               ~queue-name
+                                               (:com.github.ivarref.yoltq/lock job#)
+                                               :init)
+                         (i/take! @yq/*config*)
+                         (i/execute! @yq/*config*))]
+       (swap! (:prev-consumed @yq/*config*) assoc ~queue-name res#)
+       (test/is (= :done (:com.github.ivarref.yoltq/status res#)))
+       (if (:retval res#)
+         (:retval res#)
+         (:exception res#)))
+     (test/is false "Expected to have previously consumed something. Was nil.")))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 442acac..2b67e5e 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -282,4 +282,5 @@
                            (fn [_] (swap! cnt inc))))
     @(d/transact conn [(yq/put :q nil)])
     (is (= 1 (tq/consume! :q)))
-    #_(is (= 2 (tq/force-retry! :q)))))
+    (is (= 2 (tq/force-retry! :q)))
+    (is (= 3 (tq/force-retry! :q)))))
-- 
cgit v1.2.3


From dc2e14b4e1e91e6fefecc01c312a44c0033640c9 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Thu, 23 Sep 2021 13:01:23 +0200
Subject: Basic depends-on works for test queue

---
 src/com/github/ivarref/yoltq.clj               | 12 +++---
 src/com/github/ivarref/yoltq/impl.clj          | 51 +++++++++++++++++++++-----
 src/com/github/ivarref/yoltq/test_queue.clj    | 27 ++++++++------
 src/com/github/ivarref/yoltq/utils.clj         |  1 +
 test/com/github/ivarref/yoltq/test_utils.clj   |  2 +-
 test/com/github/ivarref/yoltq/virtual_test.clj | 27 ++++++++++++++
 6 files changed, 92 insertions(+), 28 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 58efca1..3164020 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -94,11 +94,13 @@
    (swap! *config* (fn [old-config] (assoc-in old-config [:handlers queue-id] (merge opts {:f f}))))))
 
 
-(defn put [queue-id payload]
-  (let [{:keys [bootstrap-poller! conn] :as cfg} @*config*]
-    (when (and *test-mode* bootstrap-poller!)
-      (bootstrap-poller! conn))
-    (i/put cfg queue-id payload)))
+(defn put
+  ([queue-id payload] (put queue-id payload {}))
+  ([queue-id payload opts]
+   (let [{:keys [bootstrap-poller! conn] :as cfg} @*config*]
+     (when (and *test-mode* bootstrap-poller!)
+       (bootstrap-poller! conn))
+     (i/put cfg queue-id payload opts))))
 
 
 (defn- do-start! []
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 9c95cff..9811c93 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -8,9 +8,11 @@
 
 (def schema
   [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
+   #:db{:ident :com.github.ivarref.yoltq/ext-id, :cardinality :db.cardinality/one, :valueType :db.type/string, :unique :db.unique/value}
    #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
+   #:db{:ident :com.github.ivarref.yoltq/opts, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/bindings, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/tries, :cardinality :db.cardinality/one, :valueType :db.type/long, :noHistory true}
    #:db{:ident :com.github.ivarref.yoltq/lock, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :noHistory true}
@@ -20,8 +22,10 @@
    #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}])
 
 
-(defn put [{:keys [capture-bindings] :as config}
-           queue-name payload]
+(defn put [{:keys [capture-bindings conn] :as config}
+           queue-name
+           payload
+           opts]
   (if-let [_ (get-in config [:handlers queue-name])]
     (let [id (u/squuid)
           str-bindings (->> (reduce (fn [o k]
@@ -30,19 +34,46 @@
                                     (or capture-bindings []))
                             (pr-str))]
       (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
-      {:com.github.ivarref.yoltq/id         id
-       :com.github.ivarref.yoltq/queue-name queue-name
-       :com.github.ivarref.yoltq/status     u/status-init
-       :com.github.ivarref.yoltq/payload    (pr-str payload)
-       :com.github.ivarref.yoltq/bindings   str-bindings
-       :com.github.ivarref.yoltq/lock       (u/random-uuid)
-       :com.github.ivarref.yoltq/tries      0
-       :com.github.ivarref.yoltq/init-time  (u/now-ns)})
+      (merge
+        {:com.github.ivarref.yoltq/id         id
+         :com.github.ivarref.yoltq/queue-name queue-name
+         :com.github.ivarref.yoltq/status     u/status-init
+         :com.github.ivarref.yoltq/payload    (pr-str payload)
+         :com.github.ivarref.yoltq/bindings   str-bindings
+         :com.github.ivarref.yoltq/opts       (pr-str (or opts {}))
+         :com.github.ivarref.yoltq/lock       (u/random-uuid)
+         :com.github.ivarref.yoltq/tries      0
+         :com.github.ivarref.yoltq/init-time  (u/now-ns)}
+        (when-let [[q ext-id] (:depends-on opts)]
+          (when-not (d/q '[:find ?e .
+                           :in $ ?ext-id
+                           :where
+                           [?e :com.github.ivarref.yoltq/ext-id ?ext-id]]
+                         (d/db conn)
+                         (pr-str [q ext-id]))
+            (throw (ex-info ":depends-on not found in database" opts))))
+        (when-let [ext-id (:id opts)]
+          {:com.github.ivarref.yoltq/ext-id (pr-str [queue-name ext-id])})))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
 
 
+(defn depends-on-waiting? [{:keys [conn]}
+                           {:keys [id]}]
+  (let [db (d/db conn)]
+    (when-let [{:com.github.ivarref.yoltq/keys [opts]} (u/get-queue-item db id)]
+      (when-let [[q id :as depends-on] (:depends-on opts)]
+        (when-not (d/q '[:find ?e .
+                         :in $ ?ext-id
+                         :where
+                         [?e :com.github.ivarref.yoltq/ext-id ?ext-id]
+                         [?e :com.github.ivarref.yoltq/status :done]]
+                       db
+                       (pr-str [q id]))
+          {:depends-on depends-on})))))
+
+
 (defn take! [{:keys [conn cas-failures hung-log-level tx-spent-time!]
               :or   {hung-log-level :error}}
              {:keys [tx id queue-name was-hung? to-error?] :as queue-item-info}]
diff --git a/src/com/github/ivarref/yoltq/test_queue.clj b/src/com/github/ivarref/yoltq/test_queue.clj
index 4c4f903..6183216 100644
--- a/src/com/github/ivarref/yoltq/test_queue.clj
+++ b/src/com/github/ivarref/yoltq/test_queue.clj
@@ -148,18 +148,21 @@
   `(if-let [job# (get-tx-q-job ~queue-name)]
      (try
        (with-bindings (:com.github.ivarref.yoltq/bindings job#)
-         (let [res# (some->> (u/prepare-processing (d/db (:conn @yq/*config*))
-                                                   (:com.github.ivarref.yoltq/id job#)
-                                                   ~queue-name
-                                                   (:com.github.ivarref.yoltq/lock job#)
-                                                   (:com.github.ivarref.yoltq/status job#))
-                             (i/take! @yq/*config*)
-                             (i/execute! @yq/*config*))]
-           (swap! (:prev-consumed @yq/*config*) assoc ~queue-name res#)
-           (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
-           (if (:retval res#)
-             (:retval res#)
-             (:exception res#))))
+         (let [prep# (u/prepare-processing (d/db (:conn @yq/*config*))
+                                           (:com.github.ivarref.yoltq/id job#)
+                                           ~queue-name
+                                           (:com.github.ivarref.yoltq/lock job#)
+                                           (:com.github.ivarref.yoltq/status job#))]
+           (if-let [depends-on# (i/depends-on-waiting? @yq/*config* prep#)]
+             depends-on#
+             (let [res# (some->> prep#
+                                 (i/take! @yq/*config*)
+                                 (i/execute! @yq/*config*))]
+               (swap! (:prev-consumed @yq/*config*) assoc ~queue-name res#)
+               (test/is (= ~expected-status (:com.github.ivarref.yoltq/status res#)))
+               (if (:retval res#)
+                 (:retval res#)
+                 (:exception res#))))))
        (catch Throwable t#
          (log/error t# "unexpected error in consume-expect:" (ex-message t#))
          (throw t#)))
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index 9501343..d551510 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -56,6 +56,7 @@
   (-> (d/pull db '[:*] [:com.github.ivarref.yoltq/id id])
       (dissoc :db/id)
       (update :com.github.ivarref.yoltq/payload edn/read-string)
+      (update :com.github.ivarref.yoltq/opts (fn [s] (or (when s (edn/read-string s)) {})))
       (update :com.github.ivarref.yoltq/bindings
               (fn [s]
                 (when s
diff --git a/test/com/github/ivarref/yoltq/test_utils.clj b/test/com/github/ivarref/yoltq/test_utils.clj
index df56460..5427ff5 100644
--- a/test/com/github/ivarref/yoltq/test_utils.clj
+++ b/test/com/github/ivarref/yoltq/test_utils.clj
@@ -35,7 +35,7 @@
 
 
 (defn put-transact! [id payload]
-  @(d/transact (:conn @yq/*config*) [(i/put @yq/*config* id payload)]))
+  @(d/transact (:conn @yq/*config*) [(i/put @yq/*config* id payload {})]))
 
 
 (defn advance! [tp]
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 2b67e5e..789e5b4 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -284,3 +284,30 @@
     (is (= 1 (tq/consume! :q)))
     (is (= 2 (tq/force-retry! :q)))
     (is (= 3 (tq/force-retry! :q)))))
+
+
+(deftest ext-id-no-duplicates
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q identity)
+    @(d/transact conn [(yq/put :q nil {:id "123"})])
+    (is (thrown? Exception @(d/transact conn [(yq/put :q nil {:id "123"})])))))
+
+
+(deftest depends-on
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :a identity)
+    (yq/add-consumer! :b identity)
+    @(d/transact conn [(yq/put :a "a" {:id "1"})])
+    (is (thrown? Exception @(d/transact conn [(yq/put :b "b" {:depends-on [:a "0"]})])))
+    @(d/transact conn [(yq/put :b "b" {:depends-on [:a "1"]})])
+
+    ; can't consume :b yet:
+    (is (= {:depends-on [:a "1"]} (tq/consume! :b)))
+    (is (= {:depends-on [:a "1"]} (tq/consume! :b)))
+
+    (is (= "a" (tq/consume! :a)))
+    (is (= "b" (tq/consume! :b)))
+    (is (= "b" (tq/force-retry! :b)))))
+
-- 
cgit v1.2.3


From cc9cc0ed52ca2d4fa82f2fe7dc5f17e61ced26f4 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Thu, 23 Sep 2021 13:12:12 +0200
Subject: Basic depends-on seems to work

---
 src/com/github/ivarref/yoltq/impl.clj         |  5 +++--
 src/com/github/ivarref/yoltq/poller.clj       |  8 +++++---
 src/com/github/ivarref/yoltq/report_queue.clj | 10 ++++++----
 3 files changed, 14 insertions(+), 9 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 9811c93..a315545 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -60,9 +60,9 @@
 
 
 (defn depends-on-waiting? [{:keys [conn]}
-                           {:keys [id]}]
+                           q-item]
   (let [db (d/db conn)]
-    (when-let [{:com.github.ivarref.yoltq/keys [opts]} (u/get-queue-item db id)]
+    (when-let [{:com.github.ivarref.yoltq/keys [opts]} (u/get-queue-item db (:id q-item))]
       (when-let [[q id :as depends-on] (:depends-on opts)]
         (when-not (d/q '[:find ?e .
                          :in $ ?ext-id
@@ -71,6 +71,7 @@
                          [?e :com.github.ivarref.yoltq/status :done]]
                        db
                        (pr-str [q id]))
+          (log/info "queue item" (str (:id q-item)) "is waiting on" depends-on)
           {:depends-on depends-on})))))
 
 
diff --git a/src/com/github/ivarref/yoltq/poller.clj b/src/com/github/ivarref/yoltq/poller.clj
index 1f4e65d..28b158f 100644
--- a/src/com/github/ivarref/yoltq/poller.clj
+++ b/src/com/github/ivarref/yoltq/poller.clj
@@ -10,9 +10,11 @@
                     :error (u/get-error cfg q)
                     :hung (u/get-hung cfg q))]
     (with-bindings (get item :bindings {})
-      (some->> item
-               (i/take! cfg)
-               (i/execute! cfg)))))
+      (if (i/depends-on-waiting? cfg item)
+        nil
+        (some->> item
+                 (i/take! cfg)
+                 (i/execute! cfg))))))
 
 
 (defn poll-queue! [running?
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index c6559bf..20e0a93 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -21,10 +21,12 @@
                     (try
                       (let [{:com.github.ivarref.yoltq/keys [lock id status queue-name bindings]} (u/get-queue-item db-after id)]
                         (with-bindings (or bindings {})
-                          (some->>
-                            (u/prepare-processing db-after id queue-name lock status)
-                            (i/take! cfg)
-                            (i/execute! cfg))))
+                          (if (i/depends-on-waiting? cfg {:id id})
+                            nil
+                            (some->>
+                              (u/prepare-processing db-after id queue-name lock status)
+                              (i/take! cfg)
+                              (i/execute! cfg)))))
                       (catch Throwable t
                         (log/error t "unexpected error in process-poll-result!")))))))))
 
-- 
cgit v1.2.3


From f2bc137283616b46aad9519cacade93969af3fdb Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 24 Sep 2021 10:42:56 +0200
Subject: Be paranoid when persisting with pr-str

---
 src/com/github/ivarref/yoltq/impl.clj          | 23 +++++++++++++++++------
 test/com/github/ivarref/yoltq/virtual_test.clj |  8 ++++++++
 2 files changed, 25 insertions(+), 6 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index a315545..adc169d 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -3,7 +3,8 @@
             [clojure.tools.logging :as log]
             [clojure.string :as str]
             [com.github.ivarref.yoltq.utils :as u]
-            [com.github.ivarref.yoltq.ext-sys :as ext]))
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [clojure.edn :as edn]))
 
 
 (def schema
@@ -22,6 +23,16 @@
    #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}])
 
 
+(defn pr-str-safe [what x]
+  (try
+    (if (= x (edn/read-string (pr-str x)))
+      (pr-str x)
+      (throw (ex-info (str "Could not read-string " what) {:input x})))
+    (catch Exception e
+      (log/error "could not read-string" what ":" (ex-message e))
+      (throw e))))
+
+
 (defn put [{:keys [capture-bindings conn] :as config}
            queue-name
            payload
@@ -32,15 +43,15 @@
                                       (assoc o (symbol k) (deref k)))
                                     {}
                                     (or capture-bindings []))
-                            (pr-str))]
+                            (pr-str-safe :capture-bindings))]
       (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
       (merge
         {:com.github.ivarref.yoltq/id         id
          :com.github.ivarref.yoltq/queue-name queue-name
          :com.github.ivarref.yoltq/status     u/status-init
-         :com.github.ivarref.yoltq/payload    (pr-str payload)
+         :com.github.ivarref.yoltq/payload    (pr-str-safe :payload payload)
          :com.github.ivarref.yoltq/bindings   str-bindings
-         :com.github.ivarref.yoltq/opts       (pr-str (or opts {}))
+         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts (or opts {}))
          :com.github.ivarref.yoltq/lock       (u/random-uuid)
          :com.github.ivarref.yoltq/tries      0
          :com.github.ivarref.yoltq/init-time  (u/now-ns)}
@@ -50,10 +61,10 @@
                            :where
                            [?e :com.github.ivarref.yoltq/ext-id ?ext-id]]
                          (d/db conn)
-                         (pr-str [q ext-id]))
+                         (pr-str-safe :depends-on [q ext-id]))
             (throw (ex-info ":depends-on not found in database" opts))))
         (when-let [ext-id (:id opts)]
-          {:com.github.ivarref.yoltq/ext-id (pr-str [queue-name ext-id])})))
+          {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 93ad0b6..fdbf6b3 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -307,3 +307,11 @@
 
     (is (= {:id "a1"} (tq/consume! :a)))
     (is (= {:id "b1"} (tq/consume! :b)))))
+
+
+(deftest verify-can-read-string
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :a identity)
+    (timbre/with-level :fatal
+      (is (thrown? Exception @(d/transact conn [(yq/put :a {:broken #'=})]))))))
-- 
cgit v1.2.3


From e142149a4282a669f3f95cb52f708d234a8ded23 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Fri, 24 Sep 2021 10:59:06 +0200
Subject: Support :depends-on on queue level

---
 src/com/github/ivarref/yoltq/impl.clj          | 11 ++++++++---
 test/com/github/ivarref/yoltq/virtual_test.clj | 15 +++++++++++++++
 2 files changed, 23 insertions(+), 3 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index adc169d..50441ff 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -37,8 +37,9 @@
            queue-name
            payload
            opts]
-  (if-let [_ (get-in config [:handlers queue-name])]
+  (if-let [q-config (get-in config [:handlers queue-name])]
     (let [id (u/squuid)
+          depends-on (get q-config :depends-on (fn [_] nil))
           str-bindings (->> (reduce (fn [o k]
                                       (assoc o (symbol k) (deref k)))
                                     {}
@@ -51,11 +52,15 @@
          :com.github.ivarref.yoltq/status     u/status-init
          :com.github.ivarref.yoltq/payload    (pr-str-safe :payload payload)
          :com.github.ivarref.yoltq/bindings   str-bindings
-         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts (or opts {}))
+         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts
+                                                           (merge
+                                                             (when-let [deps (depends-on payload)]
+                                                               {:depends-on deps})
+                                                             (or opts {})))
          :com.github.ivarref.yoltq/lock       (u/random-uuid)
          :com.github.ivarref.yoltq/tries      0
          :com.github.ivarref.yoltq/init-time  (u/now-ns)}
-        (when-let [[q ext-id] (:depends-on opts)]
+        (when-let [[q ext-id] (or (:depends-on opts) (depends-on payload))]
           (when-not (d/q '[:find ?e .
                            :in $ ?ext-id
                            :where
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index fdbf6b3..3f7365f 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -309,6 +309,21 @@
     (is (= {:id "b1"} (tq/consume! :b)))))
 
 
+(deftest depends-on-queue-level
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :a identity)
+    (yq/add-consumer! :b identity {:depends-on (fn [{:keys [id]}] [:a id])})
+    @(d/transact conn [(yq/put :a {:id "1"} {:id "1"})])
+    @(d/transact conn [(yq/put :b {:id "1"})])
+
+    ; can't consume :b yet:
+    (is (= {:depends-on [:a "1"]} (tq/consume! :b)))
+
+    (is (= {:id "1"} (tq/consume! :a)))
+    (is (= {:id "1"} (tq/consume! :b)))))
+
+
 (deftest verify-can-read-string
   (let [conn (u/empty-conn)]
     (yq/init! {:conn conn})
-- 
cgit v1.2.3


From 384a3b72eeb6f4b00a70b8eeeeeab1934288485e Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Mon, 27 Sep 2021 08:35:27 +0200
Subject: Better error reporting

---
 src/com/github/ivarref/yoltq/impl.clj | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 50441ff..f97dcc4 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -67,7 +67,7 @@
                            [?e :com.github.ivarref.yoltq/ext-id ?ext-id]]
                          (d/db conn)
                          (pr-str-safe :depends-on [q ext-id]))
-            (throw (ex-info ":depends-on not found in database" opts))))
+            (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
         (when-let [ext-id (:id opts)]
           {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})))
     (do
-- 
cgit v1.2.3


From c62632771b11736eac616e00d576c349e54b6a73 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Mon, 27 Sep 2021 09:39:54 +0200
Subject: Simplify

---
 src/com/github/ivarref/yoltq/impl.clj | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index f97dcc4..02cc102 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -40,6 +40,10 @@
   (if-let [q-config (get-in config [:handlers queue-name])]
     (let [id (u/squuid)
           depends-on (get q-config :depends-on (fn [_] nil))
+          opts (merge
+                 (when-let [deps (depends-on payload)]
+                   {:depends-on deps})
+                 (or opts {}))
           str-bindings (->> (reduce (fn [o k]
                                       (assoc o (symbol k) (deref k)))
                                     {}
@@ -52,15 +56,11 @@
          :com.github.ivarref.yoltq/status     u/status-init
          :com.github.ivarref.yoltq/payload    (pr-str-safe :payload payload)
          :com.github.ivarref.yoltq/bindings   str-bindings
-         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts
-                                                           (merge
-                                                             (when-let [deps (depends-on payload)]
-                                                               {:depends-on deps})
-                                                             (or opts {})))
+         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts opts)
          :com.github.ivarref.yoltq/lock       (u/random-uuid)
          :com.github.ivarref.yoltq/tries      0
          :com.github.ivarref.yoltq/init-time  (u/now-ns)}
-        (when-let [[q ext-id] (or (:depends-on opts) (depends-on payload))]
+        (when-let [[q ext-id] (:depends-on opts)]
           (when-not (d/q '[:find ?e .
                            :in $ ?ext-id
                            :where
-- 
cgit v1.2.3


From 79acba1b716685bb601e05a2e9824eefd19d1f5d Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <ivar.refsdal@nsd.no>
Date: Mon, 27 Sep 2021 14:36:24 +0200
Subject: Add :valid-payload? function

---
 README.md                                      |  2 ++
 src/com/github/ivarref/yoltq/impl.clj          |  4 ++++
 test/com/github/ivarref/yoltq/virtual_test.clj | 11 +++++++++++
 3 files changed, 17 insertions(+)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 314c779..7e49431 100644
--- a/README.md
+++ b/README.md
@@ -146,6 +146,8 @@ the payload. It can be added like this:
   ; An optional map of queue opts
   {:allow-cas-failure? true ; Treat [:db.cas ...] failures as success. This is one way for the
                             ; consumer function to ensure idempotence.
+   :valid-payload? (fn [payload] (some? (:id payload))) ; Function that verifies payload. Should return truthy for valid payloads.
+                                                        ; The default function always returns true.
    :max-retries 10})        ; Specify maximum number of times an item will be retried. Default: 100
 ```
 
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 02cc102..8b75fc3 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -40,6 +40,7 @@
   (if-let [q-config (get-in config [:handlers queue-name])]
     (let [id (u/squuid)
           depends-on (get q-config :depends-on (fn [_] nil))
+          valid-payload? (get q-config :valid-payload? (fn [_] true))
           opts (merge
                  (when-let [deps (depends-on payload)]
                    {:depends-on deps})
@@ -49,6 +50,9 @@
                                     {}
                                     (or capture-bindings []))
                             (pr-str-safe :capture-bindings))]
+      (when-not (valid-payload? payload)
+        (log/error "Payload was not valid. Payload was:" payload)
+        (throw (ex-info (str "Payload was not valid: " payload) {:payload payload})))
       (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
       (merge
         {:com.github.ivarref.yoltq/id         id
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 8f7b454..acd3eb7 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -331,3 +331,14 @@
     (yq/add-consumer! :a identity)
     (timbre/with-level :fatal
       (is (thrown? Exception @(d/transact conn [(yq/put :a {:broken #'=})]))))))
+
+
+(deftest payload-verifier
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q identity
+                      {:valid-payload? (fn [{:keys [id]}]
+                                         (some? id))})
+    @(d/transact conn [(yq/put :q {:id "a"})])
+    (timbre/with-level :fatal
+                       (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
\ No newline at end of file
-- 
cgit v1.2.3


From b28837ea804fbc6abd14fae23a92933b9406d5e1 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Sun, 27 Mar 2022 13:49:50 +0200
Subject: Add healthy?, queue-stats functions and default functions for
 :on-system-error and :on-system-recovery

---
 README.md                                          | 30 +++++++++++++++++++-
 deps.edn                                           |  8 ++++--
 pom.xml                                            |  4 +--
 release.sh                                         |  4 +--
 src/com/github/ivarref/yoltq.clj                   | 32 ++++++++++++++++++++--
 src/com/github/ivarref/yoltq/error_poller.clj      | 19 +++++++++----
 .../com/github/ivarref/yoltq/error_poller_test.clj |  2 +-
 7 files changed, 80 insertions(+), 19 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 7e49431..f62d46c 100644
--- a/README.md
+++ b/README.md
@@ -331,6 +331,34 @@ These dynamic bindings will be in place when yoltq logs errors, warnings
 etc. about failing consumer functions, possibly making troubleshooting
 easier.
 
+## Change log
+
+### 2022-03-27 v0.2.41
+```
+  Added function `healthy?` that returns:
+    true if no errors
+    false if one or more errors
+    nil if error-poller is yet to be executed.
+  
+  Added default functions for `:on-system-error` and `:on-system-recovery`
+  that simply logs that the system is in error (ERROR level) or has 
+  recovered (INFO level). 
+  
+  Added function `queue-stats` that returns a nicely "formatted"
+  vector of queue stats, for example:
+  (queue-stats)
+  =>
+    [{:qname :add-message-thread, :status :done, :count 10274}
+     {:qname :add-message-thread, :status :init, :count 30}
+     {:qname :add-message-thread, :status :processing, :count 1}
+     {:qname :send-message, :status :done, :count 21106}
+     {:qname :send-message, :status :init, :count 56}]
+```
+
+### 2021-09-27 v0.2.39: ?
+### 2021-09-27 v0.2.37: ?
+
+### 2021-09-24 v0.2.33: First publicly announced release.
 
 ## License
 
@@ -345,4 +373,4 @@ Licenses when the conditions for such availability set forth in the Eclipse
 Public License, v. 2.0 are satisfied: GNU General Public License as published by
 the Free Software Foundation, either version 2 of the License, or (at your
 option) any later version, with the GNU Classpath Exception which is available
-at https://www.gnu.org/software/classpath/license.html.
\ No newline at end of file
+at https://www.gnu.org/software/classpath/license.html.
diff --git a/deps.edn b/deps.edn
index a457628..d0f0a26 100644
--- a/deps.edn
+++ b/deps.edn
@@ -22,8 +22,10 @@
 
              :release {:extra-deps {ivarref/pom-patch {:mvn/version "0.1.16"}}}
 
-             :deploy  {:extra-deps {slipset/deps-deploy {:mvn/version "0.1.3"}}
-                       :main-opts  ["-m" "deps-deploy.deps-deploy" "deploy"
-                                    "target/out.jar" "true"]}}
+             :deploy  {:extra-deps {slipset/deps-deploy {:mvn/version "0.2.0"}}
+                       :exec-fn    deps-deploy.deps-deploy/deploy
+                       :exec-args  {:installer      :remote
+                                    :sign-releases? false
+                                    :artifact       "target/out.jar"}}}
 
  :mvn/repos {"my.datomic.com" {:url "https://my.datomic.com/repo"}}}
diff --git a/pom.xml b/pom.xml
index 9784836..e486fb1 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.39</version>
+  <version>0.2.40</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.39</tag>
+    <tag>v0.2.40</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/release.sh b/release.sh
index 70f67b5..dec59a2 100755
--- a/release.sh
+++ b/release.sh
@@ -13,8 +13,6 @@ git commit -m "Release $VERSION"
 git tag -a v$VERSION -m "Release v$VERSION"
 git push --follow-tags
 
-clojure -M:deploy
+clojure -X:deploy
 
 echo "Released $VERSION"
-
-rm *.pom.asc
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 3164020..03a364f 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -17,7 +17,6 @@
 (defonce ^:dynamic *running?* (atom false))
 (defonce ^:dynamic *test-mode* false)
 
-
 (def default-opts
   (-> {; Default number of times a queue job will be retried before giving up
        ; Can be overridden on a per consumer basis with
@@ -79,7 +78,8 @@
                            (-> (merge-with (fn [a b] (or b a))
                                            {:running-queues     (atom #{})
                                             :start-execute-time (atom {})
-                                            :system-error       (atom {})}
+                                            :system-error       (atom {})
+                                            :healthy?           (atom nil)}
                                            default-opts
                                            (if *test-mode* old-conf (select-keys old-conf [:handlers]))
                                            cfg)
@@ -148,6 +148,32 @@
               (reset! threadpool nil))))))
 
 
+(defn healthy? []
+  (some->> @*config*
+           :healthy?
+           (deref)))
+
+(defn queue-stats []
+  (let [{:keys [conn]} @*config*
+        db (d/db conn)]
+    (->> (d/q '[:find ?e ?qname ?status
+                :in $
+                :where
+                [?e :com.github.ivarref.yoltq/queue-name ?qname]
+                [?e :com.github.ivarref.yoltq/status ?status]]
+              db)
+         (mapv (partial zipmap [:e :qname :status]))
+         (mapv #(select-keys % [:qname :status]))
+         (mapv (fn [qitem] {qitem 1}))
+         (reduce (partial merge-with +) {})
+         (mapv (fn [[{:keys [qname status]} v]]
+                 (array-map
+                   :qname qname
+                   :status status
+                   :count v)))
+         (sort-by (juxt :qname :status))
+         (vec))))
+
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
@@ -177,4 +203,4 @@
         (start!)
         (dotimes [x n]
           @(d/transact conn [(put :q {:work 123})]))
-        nil))))
\ No newline at end of file
+        nil))))
diff --git a/src/com/github/ivarref/yoltq/error_poller.clj b/src/com/github/ivarref/yoltq/error_poller.clj
index 77339f7..1268482 100644
--- a/src/com/github/ivarref/yoltq/error_poller.clj
+++ b/src/com/github/ivarref/yoltq/error_poller.clj
@@ -66,9 +66,13 @@
 
 (defn do-poll-errors [{:keys [conn system-error
                               on-system-error
-                              on-system-recovery]
-                       :or   {on-system-error    (fn [] nil)
-                              on-system-recovery (fn [] nil)}
+                              on-system-recovery
+                              healthy?]
+                       :or   {on-system-error    (fn []
+                                                   (log/error "There are yoltq queues which have errors")
+                                                   nil)
+                              on-system-recovery (fn []
+                                                   (log/info "Yoltq recovered"))}
                        :as   config}]
   (assert (some? conn) "expected :conn to be present")
   (assert (some? system-error) "expected :system-error to be present")
@@ -79,8 +83,11 @@
                              (d/db conn)
                              u/status-error)
                         0)]
-    (when (pos-int? error-count)
-      (log/debug "poll-errors found" error-count "errors in system"))
+    (if (pos-int? error-count)
+      (do
+        (log/debug "poll-errors found" error-count "errors in system")
+        (reset! healthy? false))
+      (reset! healthy? true))
     (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config (ext/now-ns) error-count)]
       (when run-callback
         (cond (= run-callback :error)
@@ -100,7 +107,7 @@
     (when @running?
       (do-poll-errors @config-atom))
     (catch Throwable t
-      (log/error t "unexpected error in poll-erros:" (ex-message t))
+      (log/error t "unexpected error in poll-errors:" (ex-message t))
       nil)))
 
 
diff --git a/test/com/github/ivarref/yoltq/error_poller_test.clj b/test/com/github/ivarref/yoltq/error_poller_test.clj
index 2e0873e..18f0aa7 100644
--- a/test/com/github/ivarref/yoltq/error_poller_test.clj
+++ b/test/com/github/ivarref/yoltq/error_poller_test.clj
@@ -1,5 +1,5 @@
 (ns com.github.ivarref.yoltq.error-poller-test
-  (:require [clojure.test :refer :all]
+  (:require [clojure.test :refer [deftest is]]
             [com.github.ivarref.yoltq.error-poller :as ep]
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.log-init :as logconfig]
-- 
cgit v1.2.3


From 6c26a3b6871286510bb8e9770ee7f7e3abf97abe Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Sun, 27 Mar 2022 18:39:44 +0200
Subject: Start use current millis in the database, not nano offset

---
 .gitignore                                         |  3 +-
 README.md                                          | 38 ++++++++++++++--------
 deps.edn                                           |  2 +-
 src/com/github/ivarref/yoltq.clj                   |  8 ++---
 src/com/github/ivarref/yoltq/error_poller.clj      | 10 +++---
 src/com/github/ivarref/yoltq/ext_sys.clj           | 13 ++++----
 src/com/github/ivarref/yoltq/impl.clj              | 14 ++++----
 src/com/github/ivarref/yoltq/poller.clj            | 19 +++++++----
 .../ivarref/yoltq/slow_executor_detector.clj       |  4 +--
 src/com/github/ivarref/yoltq/test_queue.clj        |  2 +-
 src/com/github/ivarref/yoltq/utils.clj             | 19 ++++++-----
 test/com/github/ivarref/yoltq/test_utils.clj       |  9 ++---
 12 files changed, 81 insertions(+), 60 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/.gitignore b/.gitignore
index cb9a7ca..c82fdd7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,4 +9,5 @@ tree.txt
 .stage-url.txt
 *.pom.asc
 *.pom
-temp/
\ No newline at end of file
+temp/
+.clj-kondo/
diff --git a/README.md b/README.md
index 45ba8c4..9c5669c 100644
--- a/README.md
+++ b/README.md
@@ -333,12 +333,21 @@ easier.
 
 ## Change log
 
-### 2022-03-27 [v0.2.41](https://github.com/ivarref/yoltq/compare/v0.2.39...v0.2.41)
+### 20..-..-.. vHEAD [diff](https://github.com/ivarref/yoltq/compare/v0.2.41...HEAD)
+* Critical bugfix.
+```
+Started using (System/currentTimeMillis) and not (System/nanoTime)
+when storing time in the database. 
+```
+
+* Bump Clojure to `1.11.0`.
+
+### 2022-03-27 v0.2.41 [diff](https://github.com/ivarref/yoltq/compare/v0.2.39...v0.2.41)
 * Added function `healthy?` that returns:
 ```
-    true if no errors
-    false if one or more errors
-    nil if error-poller is yet to be executed.
+  true if no errors
+  false if one or more errors
+  nil if error-poller is yet to be executed.
 ```
 
 * Added default functions for `:on-system-error` and `:on-system-recovery`
@@ -348,22 +357,23 @@ easier.
 * Added function `queue-stats` that returns a nicely "formatted"
   vector of queue stats, for example:
 ```
-(queue-stats)
-=>
-[{:qname :add-message-thread, :status :done, :count 10274}
- {:qname :add-message-thread, :status :init, :count 30}
- {:qname :add-message-thread, :status :processing, :count 1}
- {:qname :send-message, :status :done, :count 21106}
- {:qname :send-message, :status :init, :count 56}]
+  (queue-stats)
+  =>
+  [{:qname :add-message-thread, :status :done, :count 10274}
+   {:qname :add-message-thread, :status :init, :count 30}
+   {:qname :add-message-thread, :status :processing, :count 1}
+   {:qname :send-message, :status :done, :count 21106}
+   {:qname :send-message, :status :init, :count 56}]
 ```
 
-### 2021-09-27 [v0.2.39](https://github.com/ivarref/yoltq/compare/v0.2.37...v0.2.39)
+### 2021-09-27 v0.2.39 [diff](https://github.com/ivarref/yoltq/compare/v0.2.37...v0.2.39)
 Added `:valid-payload?` option for queue consumers.
 
-### 2021-09-27 [v0.2.37](https://github.com/ivarref/yoltq/compare/v0.2.33...v0.2.37) 
+### 2021-09-27 v0.2.37 [diff](https://github.com/ivarref/yoltq/compare/v0.2.33...v0.2.37) 
 Improved error reporting.
 
-### 2021-09-24 v0.2.33: First publicly announced release.
+### 2021-09-24 v0.2.33
+First publicly announced release.
 
 ## License
 
diff --git a/deps.edn b/deps.edn
index d0f0a26..8e769e1 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,5 +1,5 @@
 {:deps      {org.clojure/tools.logging {:mvn/version "1.1.0"}
-             org.clojure/clojure       {:mvn/version "1.10.3"}}
+             org.clojure/clojure       {:mvn/version "1.11.0"}}
 
  :paths     ["src"]
 
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 03a364f..17aa40a 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -19,7 +19,7 @@
 
 (def default-opts
   (-> {; Default number of times a queue job will be retried before giving up
-       ; Can be overridden on a per consumer basis with
+       ; Can be overridden on a per-consumer basis with
        ; (yq/add-consumer! :q (fn [payload] ...) {:max-retries 200})
        :max-retries                   100
 
@@ -34,7 +34,7 @@
        :hung-backoff-time             (Duration/ofMinutes 30)
 
        ; Most queue jobs in init state will be consumed by the tx-report-queue listener.
-       ; However in the case where a init job was added right before the application
+       ; However, in the case where an init job was added right before the application
        ; was shut down and did not have time to be processed by the tx-report-queue listener,
        ; it will be consumer by the init poller. This init poller backs off by
        ; :init-backoff-time to avoid unnecessary compare-and-swap lock failures that could
@@ -66,7 +66,7 @@
        ; How often should the system invoke
        :system-error-callback-backoff (Duration/ofHours 1)}
 
-      u/duration->nanos))
+      u/duration->millis))
 
 
 (defn init! [{:keys [conn] :as cfg}]
@@ -83,7 +83,7 @@
                                            default-opts
                                            (if *test-mode* old-conf (select-keys old-conf [:handlers]))
                                            cfg)
-                               u/duration->nanos)))]
+                               u/duration->millis)))]
       new-cfg)))
 
 
diff --git a/src/com/github/ivarref/yoltq/error_poller.clj b/src/com/github/ivarref/yoltq/error_poller.clj
index 1268482..ee6359e 100644
--- a/src/com/github/ivarref/yoltq/error_poller.clj
+++ b/src/com/github/ivarref/yoltq/error_poller.clj
@@ -22,7 +22,7 @@
                                   state       :recovery}}
                           {:keys [system-error-min-count system-error-callback-backoff]
                            :or   {system-error-min-count 3}}
-                          now-ns
+                          now-ms
                           error-count]
   (let [new-errors (->> (conj errors error-count)
                         (take-last system-error-min-count)
@@ -50,14 +50,14 @@
           (when (and (= old-state :recovery)
                      (= new-state :error))
             {:run-callback :error
-             :last-notify  now-ns})
+             :last-notify  now-ms})
 
           (when (and (= new-state :error)
                      (= old-state :error)
-                     (> now-ns
+                     (> now-ms
                         (+ last-notify system-error-callback-backoff)))
             {:run-callback :error
-             :last-notify  now-ns})
+             :last-notify  now-ms})
 
           (when (and (= new-state :recovery)
                      (= old-state :error))
@@ -88,7 +88,7 @@
         (log/debug "poll-errors found" error-count "errors in system")
         (reset! healthy? false))
       (reset! healthy? true))
-    (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config (ext/now-ns) error-count)]
+    (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config (ext/now-ms) error-count)]
       (when run-callback
         (cond (= run-callback :error)
               (on-system-error)
diff --git a/src/com/github/ivarref/yoltq/ext_sys.clj b/src/com/github/ivarref/yoltq/ext_sys.clj
index 3480475..692b934 100644
--- a/src/com/github/ivarref/yoltq/ext_sys.clj
+++ b/src/com/github/ivarref/yoltq/ext_sys.clj
@@ -1,17 +1,18 @@
 (ns com.github.ivarref.yoltq.ext-sys
   (:require [datomic.api :as d])
+  (:refer-clojure :exclude [random-uuid])
   (:import (java.util UUID)))
 
 
-(def ^:dynamic *now-ns-atom* nil)
+(def ^:dynamic *now-ms-atom* nil)
 (def ^:dynamic *squuid-atom* nil)
 (def ^:dynamic *random-atom* nil)
 
 
-(defn now-ns []
-  (if *now-ns-atom*
-    @*now-ns-atom*
-    (System/nanoTime)))
+(defn now-ms []
+  (if *now-ms-atom*
+    @*now-ms-atom*
+    (System/currentTimeMillis)))
 
 
 (defn squuid []
@@ -23,4 +24,4 @@
 (defn random-uuid []
   (if *random-atom*
     (UUID/fromString (str "00000000-0000-0000-0000-" (format "%012d" (swap! *random-atom* inc))))
-    (UUID/randomUUID)))
\ No newline at end of file
+    (UUID/randomUUID)))
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 8b75fc3..b4eef8d 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -63,7 +63,7 @@
          :com.github.ivarref.yoltq/opts       (pr-str-safe :opts opts)
          :com.github.ivarref.yoltq/lock       (u/random-uuid)
          :com.github.ivarref.yoltq/tries      0
-         :com.github.ivarref.yoltq/init-time  (u/now-ns)}
+         :com.github.ivarref.yoltq/init-time  (u/now-ms)}
         (when-let [[q ext-id] (:depends-on opts)]
           (when-not (d/q '[:find ?e .
                            :in $ ?ext-id
@@ -138,8 +138,8 @@
               [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/tries tries (inc tries)]
               [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status u/status-processing new-status]
               (if (= new-status u/status-done)
-                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/done-time (u/now-ns)}
-                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time (u/now-ns)})]
+                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/done-time (u/now-ms)}
+                {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/error-time (u/now-ms)})]
           start-time (System/nanoTime)
           {:keys [db-after]} @(d/transact conn tx)]
       (when tx-spent-time! (tx-spent-time! (- (System/nanoTime) start-time)))
@@ -171,7 +171,7 @@
           (log/debug "queue item" (str id) "for queue" queue-name "is now processing")
           (let [{:keys [retval exception]}
                 (try
-                  (swap! start-execute-time assoc (Thread/currentThread) [(ext/now-ns) id queue-name])
+                  (swap! start-execute-time assoc (Thread/currentThread) [(ext/now-ms) id queue-name])
                   (let [v (f payload)]
                     {:retval v})
                   (catch Throwable t
@@ -188,7 +188,7 @@
               (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
                 (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
                   (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
-                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ms) init-time)))
                   (assoc q-item :retval retval :success? true :allow-cas-failure? true)))
 
               (some? exception)
@@ -198,14 +198,14 @@
                   (log/logp level exception (fmt id queue-name u/status-error tries (- error-time init-time)))
                   (log/logp level exception "error message was:" (str \" (ex-message exception) \") "for queue-item" (str id))
                   (log/logp level exception "ex-data was:" (ex-data exception) "for queue-item" (str id))
-                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ms) init-time)))
                   (assoc q-item :exception exception)))
 
               :else
               (when-let [q-item (mark-status-fn! cfg queue-item u/status-done)]
                 (let [{:com.github.ivarref.yoltq/keys [init-time done-time tries]} q-item]
                   (log/info (fmt id queue-name u/status-done tries (- done-time init-time)))
-                  (when collect-spent-time! (collect-spent-time! (- (u/now-ns) init-time)))
+                  (when collect-spent-time! (collect-spent-time! (- (u/now-ms) init-time)))
                   (assoc q-item :retval retval :success? true))))))
         (do
           (log/error "no handler for queue" queue-name)
diff --git a/src/com/github/ivarref/yoltq/poller.clj b/src/com/github/ivarref/yoltq/poller.clj
index 28b158f..9cf81c7 100644
--- a/src/com/github/ivarref/yoltq/poller.clj
+++ b/src/com/github/ivarref/yoltq/poller.clj
@@ -25,17 +25,16 @@
       (if-not (contains? old q)
         (try
           (log/debug "polling queue" queue-name "for status" status)
-          (let [start-time (u/now-ns)
+          (let [start-time (u/now-ms)
                 last-res (loop [prev-res nil]
                            (when @running?
                              (let [res (poll-once! cfg queue-name status)]
+                               (log/debug "poll-once! returned" res)
                                (if (and res (:success? res))
                                  (recur res)
                                  prev-res))))]
-            (let [spent-ns (- (u/now-ns) start-time)]
-              (log/trace "done polling queue" q "in"
-                         (format "%.1f" (double (/ spent-ns 1e6)))
-                         "ms"))
+            (let [spent-ms (- (u/now-ms) start-time)]
+              (log/trace "done polling queue" q "in" spent-ms "ms"))
             last-res)
           (finally
             (swap! running-queues disj q)))
@@ -44,6 +43,14 @@
       (log/error t "poll-queue! crashed:" (ex-message t)))
     (finally)))
 
+(comment
+  (def cfg @com.github.ivarref.yoltq/*config*))
+
+(comment
+  (poll-queue!
+    (atom true)
+    @com.github.ivarref.yoltq/*config*
+    [:add-message-thread :init]))
 
 (defn poll-all-queues! [running? config-atom pool]
   (try
@@ -54,4 +61,4 @@
                                   [q-name status])))]
           (.execute pool (fn [] (poll-queue! running? @config-atom q))))))
     (catch Throwable t
-      (log/error t "poll-all-queues! crashed:" (ex-message t)))))
\ No newline at end of file
+      (log/error t "poll-all-queues! crashed:" (ex-message t)))))
diff --git a/src/com/github/ivarref/yoltq/slow_executor_detector.clj b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
index f15ef7d..80d3718 100644
--- a/src/com/github/ivarref/yoltq/slow_executor_detector.clj
+++ b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
@@ -7,7 +7,7 @@
 (defn- do-show-slow-threads [{:keys [start-execute-time
                                      max-execute-time]}]
   (doseq [[^Thread thread [start-time queue-id queue-name]] @start-execute-time]
-    (when (> (ext/now-ns) (+ start-time max-execute-time))
+    (when (> (ext/now-ms) (+ start-time max-execute-time))
       (log/error "thread" (.getName thread) "spent too much time on"
                  "queue item" (str queue-id)
                  "for queue" queue-name
@@ -25,4 +25,4 @@
       (dotimes [_ 3]
         (when @running? (Thread/sleep 1000))))
     (catch Throwable t
-      (log/error t "reap! crashed:" (ex-message t)))))
\ No newline at end of file
+      (log/error t "reap! crashed:" (ex-message t)))))
diff --git a/src/com/github/ivarref/yoltq/test_queue.clj b/src/com/github/ivarref/yoltq/test_queue.clj
index 6183216..ee9cd54 100644
--- a/src/com/github/ivarref/yoltq/test_queue.clj
+++ b/src/com/github/ivarref/yoltq/test_queue.clj
@@ -47,7 +47,7 @@
      (with-bindings {#'yq/*config*       config#
                      #'yq/*running?*     (atom false)
                      #'yq/*test-mode*    true
-                     #'ext/*now-ns-atom* (atom 0)
+                     #'ext/*now-ms-atom* (atom 0)
                      #'ext/*random-atom* (atom 0)
                      #'ext/*squuid-atom* (atom 0)}
        (try
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index d551510..ad2444a 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -3,6 +3,7 @@
             [clojure.edn :as edn]
             [com.github.ivarref.yoltq.ext-sys :as ext]
             [clojure.tools.logging :as log])
+  (:refer-clojure :exclude [random-uuid])
   (:import (datomic Connection)
            (java.time Duration)))
 
@@ -13,10 +14,10 @@
 (def status-error :error)
 
 
-(defn duration->nanos [m]
+(defn duration->millis [m]
   (reduce-kv (fn [o k v]
                (if (instance? Duration v)
-                 (assoc o k (.toNanos v))
+                 (assoc o k (.toMillis v))
                  (assoc o k v)))
              {}
              m))
@@ -30,8 +31,8 @@
   (ext/random-uuid))
 
 
-(defn now-ns []
-  (ext/now-ns))
+(defn now-ms []
+  (ext/now-ms))
 
 
 (defn root-cause [e]
@@ -75,7 +76,7 @@
      :bindings   (get (get-queue-item db id) :com.github.ivarref.yoltq/bindings {})
      :tx         [[:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/lock old-lock new-lock]
                   [:db/cas [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/status old-status status-processing]
-                  {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/processing-time (now-ns)}]}))
+                  {:db/id [:com.github.ivarref.yoltq/id id] :com.github.ivarref.yoltq/processing-time (now-ms)}]}))
 
 
 (defn get-init [{:keys [conn db init-backoff-time] :as cfg} queue-name]
@@ -94,11 +95,11 @@
                              [?e :com.github.ivarref.yoltq/lock ?lock]]
                            db
                            queue-name
-                           (- (now-ns) init-backoff-time))
+                           (- (now-ms) init-backoff-time))
                       (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
         (prepare-processing db id queue-name old-lock :init))
-      (log/trace "no new-items in :init status for queue" queue-name))))
+      (log/debug "no new-items in :init status for queue" queue-name))))
 
 
 (defn get-error [{:keys [conn db error-backoff-time max-retries] :as cfg} queue-name]
@@ -120,7 +121,7 @@
                                [?e :com.github.ivarref.yoltq/lock ?lock]]
                              db
                              queue-name
-                             (- (now-ns) error-backoff-time)
+                             (- (now-ms) error-backoff-time)
                              (inc max-retries))
                         (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
@@ -131,7 +132,7 @@
   (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
-  (let [now (or now (now-ns))
+  (let [now (or now (now-ms))
         max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)
         db (or db (d/db conn))]
     (when-let [ids (->> (d/q '[:find ?id ?lock ?tries
diff --git a/test/com/github/ivarref/yoltq/test_utils.clj b/test/com/github/ivarref/yoltq/test_utils.clj
index 5427ff5..e4151c2 100644
--- a/test/com/github/ivarref/yoltq/test_utils.clj
+++ b/test/com/github/ivarref/yoltq/test_utils.clj
@@ -8,7 +8,8 @@
             [com.github.ivarref.yoltq.impl :as i]
             [clojure.edn :as edn]
             [com.github.ivarref.yoltq.ext-sys :as ext])
-  (:import (java.util UUID)))
+  (:import (java.util UUID)
+           (java.time Duration)))
 
 
 (logconfig/init-logging!
@@ -39,10 +40,10 @@
 
 
 (defn advance! [tp]
-  (assert (some? ext/*now-ns-atom*) "Expected to be running in test-mode!")
-  (swap! ext/*now-ns-atom* + (if (number? tp)
+  (assert (some? ext/*now-ms-atom*) "Expected to be running in test-mode!")
+  (swap! ext/*now-ms-atom* + (if (number? tp)
                                tp
-                               (.toNanos tp))))
+                               (.toMillis ^Duration tp))))
 
 
 (defn done-count []
-- 
cgit v1.2.3


From 41c9e08d63176cf7c239574d1d07f2b302a2d3ec Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Sun, 27 Mar 2022 21:33:00 +0200
Subject: Fix use current millis in the database, not nano offset

---
 src/com/github/ivarref/yoltq.clj               | 11 ++-
 src/com/github/ivarref/yoltq/impl.clj          |  6 +-
 src/com/github/ivarref/yoltq/migrate.clj       | 58 ++++++++++++++++
 test/com/github/ivarref/yoltq/migrate_test.clj | 92 ++++++++++++++++++++++++++
 test/com/github/ivarref/yoltq/test_utils.clj   |  7 +-
 test/com/github/ivarref/yoltq/virtual_test.clj | 14 +++-
 6 files changed, 180 insertions(+), 8 deletions(-)
 create mode 100644 src/com/github/ivarref/yoltq/migrate.clj
 create mode 100644 test/com/github/ivarref/yoltq/migrate_test.clj

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 17aa40a..1a60a45 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -6,6 +6,7 @@
             [com.github.ivarref.yoltq.poller :as poller]
             [com.github.ivarref.yoltq.error-poller :as errpoller]
             [com.github.ivarref.yoltq.slow-executor-detector :as slow-executor]
+            [com.github.ivarref.yoltq.migrate :as migrate]
             [com.github.ivarref.yoltq.utils :as u])
   (:import (datomic Connection)
            (java.util.concurrent Executors TimeUnit ExecutorService)
@@ -64,7 +65,11 @@
        :system-error-poll-delay       (Duration/ofMinutes 1)
 
        ; How often should the system invoke
-       :system-error-callback-backoff (Duration/ofHours 1)}
+       :system-error-callback-backoff (Duration/ofHours 1)
+
+       ; Should old, possibly stalled jobs be automatically be migrated
+       ; as part of `start!`?
+       :auto-migrate? true}
 
       u/duration->millis))
 
@@ -104,7 +109,9 @@
 
 
 (defn- do-start! []
-  (let [{:keys [poll-delay pool-size system-error-poll-delay]} @*config*]
+  (let [{:keys [poll-delay pool-size system-error-poll-delay auto-migrate?] :as cfg} @*config*]
+    (when auto-migrate?
+      (migrate/migrate! cfg))
     (reset! threadpool (Executors/newScheduledThreadPool (+ 2 pool-size)))
     (let [pool @threadpool
           queue-listener-ready (promise)]
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index b4eef8d..6b14ffc 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -20,7 +20,8 @@
    #:db{:ident :com.github.ivarref.yoltq/init-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
    #:db{:ident :com.github.ivarref.yoltq/processing-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
    #:db{:ident :com.github.ivarref.yoltq/done-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
-   #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}])
+   #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
+   #:db{:ident :com.github.ivarref.yoltq/version, :cardinality :db.cardinality/one, :valueType :db.type/string, :index true}])
 
 
 (defn pr-str-safe [what x]
@@ -63,7 +64,8 @@
          :com.github.ivarref.yoltq/opts       (pr-str-safe :opts opts)
          :com.github.ivarref.yoltq/lock       (u/random-uuid)
          :com.github.ivarref.yoltq/tries      0
-         :com.github.ivarref.yoltq/init-time  (u/now-ms)}
+         :com.github.ivarref.yoltq/init-time  (u/now-ms)
+         :com.github.ivarref.yoltq/version    "2"}
         (when-let [[q ext-id] (:depends-on opts)]
           (when-not (d/q '[:find ?e .
                            :in $ ?ext-id
diff --git a/src/com/github/ivarref/yoltq/migrate.clj b/src/com/github/ivarref/yoltq/migrate.clj
new file mode 100644
index 0000000..89fc286
--- /dev/null
+++ b/src/com/github/ivarref/yoltq/migrate.clj
@@ -0,0 +1,58 @@
+(ns com.github.ivarref.yoltq.migrate
+  (:require [datomic.api :as d]
+            [clojure.tools.logging :as log]))
+
+(defn to->v2-ent [{:keys [conn]} now-ms id]
+  (log/info "Migrating id" id)
+  (let [attr-val (fn [attr]
+                   (when-let [old (d/q '[:find ?time .
+                                         :in $ ?e ?a
+                                         :where
+                                         [?e ?a ?time]]
+                                       (d/db conn)
+                                       [:com.github.ivarref.yoltq/id id]
+                                       attr)]
+                     (let [now-ms (or now-ms
+                                      (.getTime (d/q '[:find (max ?txinst) .
+                                                       :in $ ?e ?a
+                                                       :where
+                                                       [?e ?a _ ?tx true]
+                                                       [?tx :db/txInstant ?txinst]]
+                                                     (d/history (d/db conn))
+                                                     [:com.github.ivarref.yoltq/id id]
+                                                     attr)))]
+                       (log/info "Updating" id attr "to" now-ms)
+                       [[:db/cas [:com.github.ivarref.yoltq/id id]
+                         attr old now-ms]])))]
+    (vec (concat [[:db/cas [:com.github.ivarref.yoltq/id id]
+                   :com.github.ivarref.yoltq/version nil "2"]]
+                 (mapcat attr-val [:com.github.ivarref.yoltq/init-time
+                                   :com.github.ivarref.yoltq/processing-time
+                                   :com.github.ivarref.yoltq/done-time
+                                   :com.github.ivarref.yoltq/error-time])))))
+
+(defn to->v2 [{:keys [conn loop? now-ms]
+               :or   {loop? true}
+               :as   cfg}]
+  (loop [tx-vec []]
+    (if-let [id (some->> (d/q '[:find [?id ...]
+                                :in $
+                                :where
+                                [?e :com.github.ivarref.yoltq/id ?id]
+                                [(missing? $ ?e :com.github.ivarref.yoltq/version)]]
+                              (d/db conn))
+                         (sort)
+                         (not-empty)
+                         (first))]
+      (let [tx (to->v2-ent cfg now-ms id)]
+        @(d/transact conn tx)
+        (if loop?
+          (recur (conj tx-vec tx))
+          tx))
+      (do
+        (log/info "No items left to migrate")
+        tx-vec))))
+
+
+(defn migrate! [cfg]
+  (to->v2 cfg))
diff --git a/test/com/github/ivarref/yoltq/migrate_test.clj b/test/com/github/ivarref/yoltq/migrate_test.clj
new file mode 100644
index 0000000..0063631
--- /dev/null
+++ b/test/com/github/ivarref/yoltq/migrate_test.clj
@@ -0,0 +1,92 @@
+(ns com.github.ivarref.yoltq.migrate-test
+  (:require [clojure.test :refer [deftest is]]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [com.github.ivarref.yoltq.migrate :as m]
+            [com.github.ivarref.yoltq.impl :as impl]
+            [com.github.ivarref.yoltq.test-utils :as tu]
+            [com.github.ivarref.yoltq.utils :as u]
+            [datomic.api :as d]))
+
+
+(deftest to-v2-migration
+  (with-bindings {#'ext/*squuid-atom* (atom 0)}
+    (let [conn (tu/empty-conn)]
+      @(d/transact conn impl/schema)
+      @(d/transact conn [{:com.github.ivarref.yoltq/id              (u/squuid)
+                          :com.github.ivarref.yoltq/queue-name      :dummy
+                          :com.github.ivarref.yoltq/status          u/status-processing
+                          :com.github.ivarref.yoltq/init-time       1
+                          :com.github.ivarref.yoltq/processing-time 2}])
+      @(d/transact conn [{:com.github.ivarref.yoltq/id         (u/squuid)
+                          :com.github.ivarref.yoltq/queue-name :dummy
+                          :com.github.ivarref.yoltq/status     u/status-init
+                          :com.github.ivarref.yoltq/init-time  3}])
+      (is (= [[[:db/cas
+                [:com.github.ivarref.yoltq/id
+                 #uuid "00000000-0000-0000-0000-000000000001"]
+                :com.github.ivarref.yoltq/version
+                nil
+                "2"]
+               [:db/cas
+                [:com.github.ivarref.yoltq/id
+                 #uuid "00000000-0000-0000-0000-000000000001"]
+                :com.github.ivarref.yoltq/init-time
+                1
+                1000]
+               [:db/cas
+                [:com.github.ivarref.yoltq/id
+                 #uuid "00000000-0000-0000-0000-000000000001"]
+                :com.github.ivarref.yoltq/processing-time
+                2
+                1000]]
+              [[:db/cas
+                [:com.github.ivarref.yoltq/id
+                 #uuid "00000000-0000-0000-0000-000000000002"]
+                :com.github.ivarref.yoltq/version
+                nil
+                "2"]
+               [:db/cas
+                [:com.github.ivarref.yoltq/id
+                 #uuid "00000000-0000-0000-0000-000000000002"]
+                :com.github.ivarref.yoltq/init-time
+                3
+                1000]]]
+             (m/migrate! {:conn   conn
+                          :now-ms 1000
+                          :loop?  true})))
+      (is (= []
+             (m/migrate! {:conn   conn
+                          :now-ms 1000
+                          :loop?  true}))))))
+
+
+(deftest to-v2-migration-real-time
+  (with-bindings {#'ext/*squuid-atom* (atom 0)}
+    (let [conn (tu/empty-conn)
+          id (u/squuid)]
+      @(d/transact conn impl/schema)
+      @(d/transact conn [{:com.github.ivarref.yoltq/id         id
+                          :com.github.ivarref.yoltq/queue-name :dummy
+                          :com.github.ivarref.yoltq/status     u/status-init
+                          :com.github.ivarref.yoltq/init-time  1}])
+      (Thread/sleep 100)
+      @(d/transact conn [{:com.github.ivarref.yoltq/id        id
+                          :com.github.ivarref.yoltq/init-time 2}])
+      (let [tx-times (->> (d/q '[:find [?txinst ...]
+                                 :in $ ?e
+                                 :where
+                                 [?e :com.github.ivarref.yoltq/init-time _ ?tx true]
+                                 [?tx :db/txInstant ?txinst]]
+                               (d/history (d/db conn))
+                               [:com.github.ivarref.yoltq/id id])
+                          (sort)
+                          (vec))]
+        (is (= 2 (count tx-times)))
+        (m/migrate! {:conn conn})
+        (is (= (.getTime (last tx-times))
+               (d/q '[:find ?init-time .
+                      :in $ ?e
+                      :where
+                      [?e :com.github.ivarref.yoltq/init-time ?init-time]]
+                    (d/db conn)
+                    [:com.github.ivarref.yoltq/id id])))))))
diff --git a/test/com/github/ivarref/yoltq/test_utils.clj b/test/com/github/ivarref/yoltq/test_utils.clj
index e4151c2..0c1b2f0 100644
--- a/test/com/github/ivarref/yoltq/test_utils.clj
+++ b/test/com/github/ivarref/yoltq/test_utils.clj
@@ -7,7 +7,8 @@
             [clojure.string :as str]
             [com.github.ivarref.yoltq.impl :as i]
             [clojure.edn :as edn]
-            [com.github.ivarref.yoltq.ext-sys :as ext])
+            [com.github.ivarref.yoltq.ext-sys :as ext]
+            [clojure.pprint :as pp])
   (:import (java.util UUID)
            (java.time Duration)))
 
@@ -54,6 +55,10 @@
        (d/db (:conn @yq/*config*))))
 
 
+(defn pp [x]
+  (pp/pprint x)
+  x)
+
 (defn get-init [& args]
   (apply u/get-init @yq/*config* args))
 
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index acd3eb7..34c9026 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -1,6 +1,6 @@
 (ns com.github.ivarref.yoltq.virtual-test
   (:require [datomic-schema.core]
-            [clojure.test :refer :all]
+            [clojure.test :refer [use-fixtures deftest is] :refer-macros [thrown?]]
             [com.github.ivarref.yoltq.test-queue :as tq]
             [com.github.ivarref.yoltq.test-utils :as u]
             [datomic.api :as d]
@@ -8,7 +8,8 @@
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.impl :as i]
             [com.github.ivarref.yoltq :as yq]
-            [taoensso.timbre :as timbre]))
+            [taoensso.timbre :as timbre]
+            [com.github.ivarref.yoltq.migrate :as migrate]))
 
 
 (use-fixtures :each tq/call-with-virtual-queue!)
@@ -21,6 +22,13 @@
     @(d/transact conn [(yq/put :q {:work 123})])
     (is (= {:work 123} (tq/consume! :q)))))
 
+(deftest happy-case-no-migration-for-new-entities
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q identity)
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (is (= {:work 123} (tq/consume! :q)))
+    (is (= [] (migrate/migrate! @yq/*config*)))))
 
 (deftest happy-case-tx-report-q
   (let [conn (u/empty-conn)]
@@ -341,4 +349,4 @@
                                          (some? id))})
     @(d/transact conn [(yq/put :q {:id "a"})])
     (timbre/with-level :fatal
-                       (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
\ No newline at end of file
+                       (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
-- 
cgit v1.2.3


From ce96806e63ead7c926a348842a3b466eba01190c Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Sun, 27 Mar 2022 22:41:49 +0200
Subject: Auto migration should run in the background and not interfere with
 polling

---
 README.md                              |  4 ++++
 src/com/github/ivarref/yoltq.clj       |  2 +-
 src/com/github/ivarref/yoltq/utils.clj | 25 ++++++++++++++++---------
 3 files changed, 21 insertions(+), 10 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 334af5d..2385d15 100644
--- a/README.md
+++ b/README.md
@@ -333,6 +333,10 @@ easier.
 
 ## Change log
 
+### 2022-03-27 v0.2.48 [diff](https://github.com/ivarref/yoltq/compare/v0.2.46...v0.2.48)
+* Auto migration is done in the background.
+* Only poll for current version of jobs, thus no races for auto migration.
+
 ### 2022-03-27 v0.2.46 [diff](https://github.com/ivarref/yoltq/compare/v0.2.41...v0.2.46)
 * Critical bugfix that in some cases can lead to stalled jobs.
 ```
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 1a60a45..4b324c4 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -111,7 +111,7 @@
 (defn- do-start! []
   (let [{:keys [poll-delay pool-size system-error-poll-delay auto-migrate?] :as cfg} @*config*]
     (when auto-migrate?
-      (migrate/migrate! cfg))
+      (future (migrate/migrate! cfg)))
     (reset! threadpool (Executors/newScheduledThreadPool (+ 2 pool-size)))
     (let [pool @threadpool
           queue-listener-ready (promise)]
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index ad2444a..39572a9 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -13,6 +13,7 @@
 (def status-done :done)
 (def status-error :error)
 
+(def current-version "2")
 
 (defn duration->millis [m]
   (reduce-kv (fn [o k v]
@@ -85,17 +86,19 @@
                                            "\nConfig was: " (str cfg)))
   (let [db (or db (d/db conn))]
     (if-let [ids (->> (d/q '[:find ?id ?lock
-                             :in $ ?queue-name ?backoff
+                             :in $ ?queue-name ?backoff ?current-version
                              :where
                              [?e :com.github.ivarref.yoltq/status :init]
                              [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
                              [?e :com.github.ivarref.yoltq/init-time ?init-time]
                              [(>= ?backoff ?init-time)]
                              [?e :com.github.ivarref.yoltq/id ?id]
-                             [?e :com.github.ivarref.yoltq/lock ?lock]]
+                             [?e :com.github.ivarref.yoltq/lock ?lock]
+                             [?e :com.github.ivarref.yoltq/version ?current-version]]
                            db
                            queue-name
-                           (- (now-ms) init-backoff-time))
+                           (- (now-ms) init-backoff-time)
+                           current-version)
                       (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
         (prepare-processing db id queue-name old-lock :init))
@@ -109,7 +112,7 @@
   (let [db (or db (d/db conn))
         max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
     (when-let [ids (->> (d/q '[:find ?id ?lock
-                               :in $ ?queue-name ?backoff ?max-tries
+                               :in $ ?queue-name ?backoff ?max-tries ?current-version
                                :where
                                [?e :com.github.ivarref.yoltq/status :error]
                                [?e :com.github.ivarref.yoltq/queue-name ?queue-name]
@@ -118,11 +121,13 @@
                                [?e :com.github.ivarref.yoltq/tries ?tries]
                                [(> ?max-tries ?tries)]
                                [?e :com.github.ivarref.yoltq/id ?id]
-                               [?e :com.github.ivarref.yoltq/lock ?lock]]
+                               [?e :com.github.ivarref.yoltq/lock ?lock]
+                               [?e :com.github.ivarref.yoltq/version ?current-version]]
                              db
                              queue-name
                              (- (now-ms) error-backoff-time)
-                             (inc max-retries))
+                             (inc max-retries)
+                             current-version)
                         (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
         (prepare-processing db id queue-name old-lock :error)))))
@@ -136,7 +141,7 @@
         max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)
         db (or db (d/db conn))]
     (when-let [ids (->> (d/q '[:find ?id ?lock ?tries
-                               :in $ ?qname ?backoff
+                               :in $ ?qname ?backoff ?current-version
                                :where
                                [?e :com.github.ivarref.yoltq/status :processing]
                                [?e :com.github.ivarref.yoltq/queue-name ?qname]
@@ -144,10 +149,12 @@
                                [(>= ?backoff ?time)]
                                [?e :com.github.ivarref.yoltq/tries ?tries]
                                [?e :com.github.ivarref.yoltq/id ?id]
-                               [?e :com.github.ivarref.yoltq/lock ?lock]]
+                               [?e :com.github.ivarref.yoltq/lock ?lock]
+                               [?e :com.github.ivarref.yoltq/version ?current-version]]
                              db
                              queue-name
-                             (- now hung-backoff-time))
+                             (- now hung-backoff-time)
+                             current-version)
                         (not-empty))]
       (let [new-lock (random-uuid)
             [id old-lock tries _t] (rand-nth (into [] ids))
-- 
cgit v1.2.3


From fc6dbf142005c57623cd1386a576b1fb487ac44a Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Mon, 28 Mar 2022 19:56:37 +0200
Subject: Don't OOM on migrating large datasets. Always prefer user specified
 value for config, also for `false`/`nil` values.

---
 src/com/github/ivarref/yoltq.clj         | 2 +-
 src/com/github/ivarref/yoltq/migrate.clj | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 4b324c4..e1fd1b0 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -80,7 +80,7 @@
     @(d/transact conn i/schema)
     (let [new-cfg (swap! *config*
                          (fn [old-conf]
-                           (-> (merge-with (fn [a b] (or b a))
+                           (-> (merge-with (fn [_ b] b)
                                            {:running-queues     (atom #{})
                                             :start-execute-time (atom {})
                                             :system-error       (atom {})
diff --git a/src/com/github/ivarref/yoltq/migrate.clj b/src/com/github/ivarref/yoltq/migrate.clj
index 89fc286..6313b73 100644
--- a/src/com/github/ivarref/yoltq/migrate.clj
+++ b/src/com/github/ivarref/yoltq/migrate.clj
@@ -47,7 +47,7 @@
       (let [tx (to->v2-ent cfg now-ms id)]
         @(d/transact conn tx)
         (if loop?
-          (recur (conj tx-vec tx))
+          (recur (vec (take 10 (conj tx-vec tx))))
           tx))
       (do
         (log/info "No items left to migrate")
-- 
cgit v1.2.3


From e73fd80b689d4d5cdc803fe92775bb9551a44df4 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Mon, 28 Mar 2022 20:34:13 +0200
Subject: Another bugfix: schedules should be using milliseconds and not
 nanoseconds.

---
 README.md                        | 3 +++
 src/com/github/ivarref/yoltq.clj | 4 ++--
 2 files changed, 5 insertions(+), 2 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index d2ae4d3..465a0cf 100644
--- a/README.md
+++ b/README.md
@@ -333,6 +333,9 @@ easier.
 
 ## Change log
 
+### 2022-03-28 v0.2.?? [diff](https://github.com/ivarref/yoltq/compare/v0.2.51...v0.2.??)
+Fixed: Schedules should now be using milliseconds and not nanoseconds.
+
 ### 2022-03-28 v0.2.51 [diff](https://github.com/ivarref/yoltq/compare/v0.2.48...v0.2.51)
 * Don't OOM on migrating large amounts of data. 
 * Respect `:auto-migrate? false`.
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index e1fd1b0..7d5434e 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -116,8 +116,8 @@
     (let [pool @threadpool
           queue-listener-ready (promise)]
       (reset! *running?* true)
-      (.scheduleAtFixedRate pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/NANOSECONDS)
-      (.scheduleAtFixedRate pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/NANOSECONDS)
+      (.scheduleAtFixedRate pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/MILLISECONDS)
+      (.scheduleAtFixedRate pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/MILLISECONDS)
       (.execute pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
       (.execute pool (fn [] (slow-executor/show-slow-threads *running?* *config*)))
       @queue-listener-ready)))
-- 
cgit v1.2.3


From 5df374a5abd25eff5ebabe3c4605d3fb704a5af7 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Tue, 29 Mar 2022 11:28:44 +0200
Subject: Release 0.2.55\nSet version numbers for change log

...

Write new release script

Write new release script

Write new release script

Release 0.2.55

Try squashing release ...

Try squashing release ...
---
 README.md                                |  6 +++++-
 pom.xml                                  |  4 ++--
 release.sh                               | 24 +++++++++++++++++++-----
 src/com/github/ivarref/yoltq.clj         |  5 +++++
 src/com/github/ivarref/yoltq/migrate.clj |  3 +++
 5 files changed, 34 insertions(+), 8 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 465a0cf..e5b2059 100644
--- a/README.md
+++ b/README.md
@@ -333,7 +333,11 @@ easier.
 
 ## Change log
 
-### 2022-03-28 v0.2.?? [diff](https://github.com/ivarref/yoltq/compare/v0.2.51...v0.2.??)
+### 2022-03-29 v0.2.55 [diff](https://github.com/ivarref/yoltq/compare/v0.2.54...v0.2.55)
+Added: `unhealthy?` function which returns `true` if there are queues in error,
+or `false` otherwise.
+
+### 2022-03-28 v0.2.54 [diff](https://github.com/ivarref/yoltq/compare/v0.2.51...v0.2.54)
 Fixed: Schedules should now be using milliseconds and not nanoseconds.
 
 ### 2022-03-28 v0.2.51 [diff](https://github.com/ivarref/yoltq/compare/v0.2.48...v0.2.51)
diff --git a/pom.xml b/pom.xml
index 28e0ece..9f591b9 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.54</version>
+  <version>0.2.55</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.54</tag>
+    <tag>v0.2.55</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/release.sh b/release.sh
index dec59a2..cf0f09f 100755
--- a/release.sh
+++ b/release.sh
@@ -2,17 +2,31 @@
 
 set -ex
 
+git update-index --refresh
+git diff-index --quiet HEAD --
+
 clojure -Spom
 clojure -M:test
 clojure -M:jar
 clojure -X:release ivarref.pom-patch/clojars-repo-only!
-VERSION=$(clojure -X:release ivarref.pom-patch/set-patch-version! :patch :commit-count+1)
 
-git add pom.xml
+LAST_TAG="$(git rev-list --tags --no-walk --max-count=1)"
+COMMITS_SINCE_LAST_TAG="$(git rev-list "$LAST_TAG"..HEAD --count)"
+echo "Squashing $COMMITS_SINCE_LAST_TAG commits ..."
+git reset --soft HEAD~"$COMMITS_SINCE_LAST_TAG"
+MSG="$(git log --format=%B --reverse HEAD..HEAD@{1})"
+git commit -m"$MSG"
+
+VERSION="$(clojure -X:release ivarref.pom-patch/set-patch-version! :patch :commit-count)"
+echo "Releasing $VERSION"
+sed -i "s/HEAD/v$VERSION/g" ./README.md
+git add pom.xml README.md
 git commit -m "Release $VERSION"
-git tag -a v$VERSION -m "Release v$VERSION"
-git push --follow-tags
+git reset --soft HEAD~2
+git commit -m"Release $VERSION\n$MSG"
 
-clojure -X:deploy
+git tag -a v"$VERSION" -m "Release v$VERSION\n$MSG"
+git push --follow-tags --force
 
+clojure -X:deploy
 echo "Released $VERSION"
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 7d5434e..bb7a43e 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -160,6 +160,11 @@
            :healthy?
            (deref)))
 
+(defn unhealthy?
+  "Returns `true` if there are queues in error, otherwise `false`."
+  []
+  (false? (healthy?)))
+
 (defn queue-stats []
   (let [{:keys [conn]} @*config*
         db (d/db conn)]
diff --git a/src/com/github/ivarref/yoltq/migrate.clj b/src/com/github/ivarref/yoltq/migrate.clj
index 6313b73..c97f679 100644
--- a/src/com/github/ivarref/yoltq/migrate.clj
+++ b/src/com/github/ivarref/yoltq/migrate.clj
@@ -56,3 +56,6 @@
 
 (defn migrate! [cfg]
   (to->v2 cfg))
+
+(comment
+  (migrate! @com.github.ivarref.yoltq/*config*))
-- 
cgit v1.2.3


From 7cf016c691fc08c81138fc592a7657087151c3ca Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Wed, 22 Jun 2022 10:26:16 +0200
Subject: Release 0.2.56 Fix line break issue?

Added support for `:yoltq/queue-id` metadata on functions
---
 README.md                                      | 37 +++++++++++++++++++-------
 deps.edn                                       |  8 +++---
 pom.xml                                        |  8 +++---
 release.sh                                     |  6 +++--
 src/com/github/ivarref/yoltq.clj               | 32 +++++++++++++++-------
 test/com/github/ivarref/yoltq/virtual_test.clj | 33 +++++++++++++++++------
 6 files changed, 87 insertions(+), 37 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index e5b2059..8ead585 100644
--- a/README.md
+++ b/README.md
@@ -333,22 +333,41 @@ easier.
 
 ## Change log
 
-### 2022-03-29 v0.2.55 [diff](https://github.com/ivarref/yoltq/compare/v0.2.54...v0.2.55)
+#### 2022-06-22 v0.2.56 [diff](https://github.com/ivarref/yoltq/compare/v0.2.55...v0.2.56)
+Added support for `:yoltq/queue-id` metadata on functions. I.e. it's possible to write
+the following:
+```clojure
+(defn my-consumer
+  {:yoltq/queue-id :some-queue}
+  [payload]
+  :work-work-work)
+
+(yq/add-consumer! #'my-consumer ; <-- will resolve to :some-queue 
+                  my-consumer)
+
+@(d/transact conn [(yq/put #'my-consumer ; <-- will resolve to :some-queue
+                           {:id "a"})])
+```
+
+The idea here is that it is simpler to jump to var definitions than going via keywords,
+which essentially refers to a var/function anyway. 
+
+#### 2022-03-29 v0.2.55 [diff](https://github.com/ivarref/yoltq/compare/v0.2.54...v0.2.55)
 Added: `unhealthy?` function which returns `true` if there are queues in error,
 or `false` otherwise.
 
-### 2022-03-28 v0.2.54 [diff](https://github.com/ivarref/yoltq/compare/v0.2.51...v0.2.54)
+#### 2022-03-28 v0.2.54 [diff](https://github.com/ivarref/yoltq/compare/v0.2.51...v0.2.54)
 Fixed: Schedules should now be using milliseconds and not nanoseconds.
 
-### 2022-03-28 v0.2.51 [diff](https://github.com/ivarref/yoltq/compare/v0.2.48...v0.2.51)
+#### 2022-03-28 v0.2.51 [diff](https://github.com/ivarref/yoltq/compare/v0.2.48...v0.2.51)
 * Don't OOM on migrating large amounts of data. 
 * Respect `:auto-migrate? false`.
 
-### 2022-03-27 v0.2.48 [diff](https://github.com/ivarref/yoltq/compare/v0.2.46...v0.2.48)
+#### 2022-03-27 v0.2.48 [diff](https://github.com/ivarref/yoltq/compare/v0.2.46...v0.2.48)
 * Auto migration is done in the background.
 * Only poll for current version of jobs, thus no races for auto migration.
 
-### 2022-03-27 v0.2.46 [diff](https://github.com/ivarref/yoltq/compare/v0.2.41...v0.2.46)
+#### 2022-03-27 v0.2.46 [diff](https://github.com/ivarref/yoltq/compare/v0.2.41...v0.2.46)
 * Critical bugfix that in some cases can lead to stalled jobs.
 ```
 Started using (System/currentTimeMillis) and not (System/nanoTime)
@@ -357,7 +376,7 @@ when storing time in the database.
 
 * Bump Clojure to `1.11.0`.
 
-### 2022-03-27 v0.2.41 [diff](https://github.com/ivarref/yoltq/compare/v0.2.39...v0.2.41)
+#### 2022-03-27 v0.2.41 [diff](https://github.com/ivarref/yoltq/compare/v0.2.39...v0.2.41)
 * Added function `healthy?` that returns:
 ```
   true if no errors
@@ -381,13 +400,13 @@ when storing time in the database.
    {:qname :send-message, :status :init, :count 56}]
 ```
 
-### 2021-09-27 v0.2.39 [diff](https://github.com/ivarref/yoltq/compare/v0.2.37...v0.2.39)
+#### 2021-09-27 v0.2.39 [diff](https://github.com/ivarref/yoltq/compare/v0.2.37...v0.2.39)
 Added `:valid-payload?` option for queue consumers.
 
-### 2021-09-27 v0.2.37 [diff](https://github.com/ivarref/yoltq/compare/v0.2.33...v0.2.37) 
+#### 2021-09-27 v0.2.37 [diff](https://github.com/ivarref/yoltq/compare/v0.2.33...v0.2.37) 
 Improved error reporting.
 
-### 2021-09-24 v0.2.33
+#### 2021-09-24 v0.2.33
 First publicly announced release.
 
 ## License
diff --git a/deps.edn b/deps.edn
index 8e769e1..6923881 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,12 +1,12 @@
-{:deps      {org.clojure/tools.logging {:mvn/version "1.1.0"}
-             org.clojure/clojure       {:mvn/version "1.11.0"}}
+{:deps      {org.clojure/tools.logging {:mvn/version "1.2.4"}
+             org.clojure/clojure       {:mvn/version "1.11.1"}}
 
  :paths     ["src"]
 
- :aliases   {:datomic {:extra-deps  {com.datomic/datomic-pro {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}}}
+ :aliases   {:datomic {:extra-deps {com.datomic/datomic-pro {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}}}
              :test    {:extra-paths ["test"]
                        :extra-deps  {ivarref/datomic-schema                  {:mvn/version "0.2.0"}
-                                     com.taoensso/timbre                     {:mvn/version "5.1.2"}
+                                     com.taoensso/timbre                     {:mvn/version "5.2.1"}
                                      com.fzakaria/slf4j-timbre               {:mvn/version "0.3.21"}
                                      clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"}
                                      com.datomic/datomic-pro                 {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}
diff --git a/pom.xml b/pom.xml
index 9f591b9..c45ccd9 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,18 +4,18 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.55</version>
+  <version>0.2.56</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>clojure</artifactId>
-      <version>1.11.0</version>
+      <version>1.11.1</version>
     </dependency>
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>tools.logging</artifactId>
-      <version>1.1.0</version>
+      <version>1.2.4</version>
     </dependency>
   </dependencies>
   <build>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.55</tag>
+    <tag>v0.2.56</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/release.sh b/release.sh
index cf0f09f..d27d125 100755
--- a/release.sh
+++ b/release.sh
@@ -23,9 +23,11 @@ sed -i "s/HEAD/v$VERSION/g" ./README.md
 git add pom.xml README.md
 git commit -m "Release $VERSION"
 git reset --soft HEAD~2
-git commit -m"Release $VERSION\n$MSG"
+git commit -m"Release $VERSION
+$MSG"
 
-git tag -a v"$VERSION" -m "Release v$VERSION\n$MSG"
+git tag -a v"$VERSION" -m "Release v$VERSION
+$MSG"
 git push --follow-tags --force
 
 clojure -X:deploy
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index bb7a43e..ba27d2c 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -1,16 +1,16 @@
 (ns com.github.ivarref.yoltq
-  (:require [datomic.api :as d]
-            [clojure.tools.logging :as log]
+  (:require [clojure.tools.logging :as log]
+            [com.github.ivarref.yoltq.error-poller :as errpoller]
             [com.github.ivarref.yoltq.impl :as i]
-            [com.github.ivarref.yoltq.report-queue :as rq]
+            [com.github.ivarref.yoltq.migrate :as migrate]
             [com.github.ivarref.yoltq.poller :as poller]
-            [com.github.ivarref.yoltq.error-poller :as errpoller]
+            [com.github.ivarref.yoltq.report-queue :as rq]
             [com.github.ivarref.yoltq.slow-executor-detector :as slow-executor]
-            [com.github.ivarref.yoltq.migrate :as migrate]
-            [com.github.ivarref.yoltq.utils :as u])
+            [com.github.ivarref.yoltq.utils :as u]
+            [datomic.api :as d])
   (:import (datomic Connection)
-           (java.util.concurrent Executors TimeUnit ExecutorService)
-           (java.time Duration)))
+           (java.time Duration)
+           (java.util.concurrent ExecutorService Executors TimeUnit)))
 
 
 (defonce ^:dynamic *config* (atom nil))
@@ -92,11 +92,23 @@
       new-cfg)))
 
 
+(defn get-queue-id
+  [queue-id-or-var]
+  (cond (and (var? queue-id-or-var)
+             (keyword? (:yoltq/queue-id (meta queue-id-or-var))))
+        (:yoltq/queue-id (meta queue-id-or-var))
+
+        (keyword? queue-id-or-var)
+        queue-id-or-var
+
+        :else
+        (throw (ex-info (str "Could not get queue-id for " queue-id-or-var) {:queue-id queue-id-or-var}))))
+
 (defn add-consumer!
   ([queue-id f]
    (add-consumer! queue-id f {}))
   ([queue-id f opts]
-   (swap! *config* (fn [old-config] (assoc-in old-config [:handlers queue-id] (merge opts {:f f}))))))
+   (swap! *config* (fn [old-config] (assoc-in old-config [:handlers (get-queue-id queue-id)] (merge opts {:f f}))))))
 
 
 (defn put
@@ -105,7 +117,7 @@
    (let [{:keys [bootstrap-poller! conn] :as cfg} @*config*]
      (when (and *test-mode* bootstrap-poller!)
        (bootstrap-poller! conn))
-     (i/put cfg queue-id payload opts))))
+     (i/put cfg (get-queue-id queue-id) payload opts))))
 
 
 (defn- do-start! []
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 34c9026..e077517 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -1,15 +1,15 @@
 (ns com.github.ivarref.yoltq.virtual-test
-  (:require [datomic-schema.core]
-            [clojure.test :refer [use-fixtures deftest is] :refer-macros [thrown?]]
+  (:require [clojure.test :refer [deftest is use-fixtures] :refer-macros [thrown?]]
+            [clojure.tools.logging :as log]
+            [com.github.ivarref.yoltq :as yq]
+            [com.github.ivarref.yoltq.impl :as i]
+            [com.github.ivarref.yoltq.migrate :as migrate]
             [com.github.ivarref.yoltq.test-queue :as tq]
             [com.github.ivarref.yoltq.test-utils :as u]
-            [datomic.api :as d]
             [com.github.ivarref.yoltq.utils :as uu]
-            [clojure.tools.logging :as log]
-            [com.github.ivarref.yoltq.impl :as i]
-            [com.github.ivarref.yoltq :as yq]
-            [taoensso.timbre :as timbre]
-            [com.github.ivarref.yoltq.migrate :as migrate]))
+            [datomic-schema.core]
+            [datomic.api :as d]
+            [taoensso.timbre :as timbre]))
 
 
 (use-fixtures :each tq/call-with-virtual-queue!)
@@ -350,3 +350,20 @@
     @(d/transact conn [(yq/put :q {:id "a"})])
     (timbre/with-level :fatal
                        (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
+
+
+(defn my-consumer
+  {:yoltq/queue-id :some-q}
+  [state payload]
+  (swap! state conj payload))
+
+(deftest queue-id-can-be-var
+  (let [conn (u/empty-conn)
+        received (atom #{})]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! #'my-consumer (partial my-consumer received))
+    @(d/transact conn [(yq/put #'my-consumer {:id "a"})])
+    (tq/consume! :some-q)
+    (is (= #{{:id "a"}} @received))
+    #_(timbre/with-level :fatal
+                         (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
-- 
cgit v1.2.3


From 1c99b2592e65f75ee38a74f7fd0dc8465c4211e1 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Wed, 29 Jun 2022 09:08:09 +0200
Subject: Release 0.2.57 Add get-errors and retry-one-error! as well as improve
 unhealthy?

---
 README.md                        |  9 +++++++++
 pom.xml                          |  4 ++--
 src/com/github/ivarref/yoltq.clj | 33 ++++++++++++++++++++++++++++-----
 3 files changed, 39 insertions(+), 7 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 8ead585..c62328c 100644
--- a/README.md
+++ b/README.md
@@ -333,6 +333,15 @@ easier.
 
 ## Change log
 
+#### 2022-06-29 v0.2.57 [diff](https://github.com/ivarref/yoltq/compare/v0.2.56...v0.2.57)
+Added `(get-errors qname)` and `(retry-one-error! qname)`.
+
+Improved:
+`unhealthy?` will return `false` for the first 10 minutes of the application lifetime.
+This was done in order to push new code while a queue was in error in an earlier
+version of the code. In this way rolling upgrades are possible regardless if there
+are queue errors.
+
 #### 2022-06-22 v0.2.56 [diff](https://github.com/ivarref/yoltq/compare/v0.2.55...v0.2.56)
 Added support for `:yoltq/queue-id` metadata on functions. I.e. it's possible to write
 the following:
diff --git a/pom.xml b/pom.xml
index c45ccd9..2d992c9 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.56</version>
+  <version>0.2.57</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.56</tag>
+    <tag>v0.2.57</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index ba27d2c..f4c2bf7 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -10,7 +10,8 @@
             [datomic.api :as d])
   (:import (datomic Connection)
            (java.time Duration)
-           (java.util.concurrent ExecutorService Executors TimeUnit)))
+           (java.util.concurrent ExecutorService Executors TimeUnit)
+           (java.lang.management ManagementFactory)))
 
 
 (defonce ^:dynamic *config* (atom nil))
@@ -168,12 +169,14 @@
 
 
 (defn healthy? []
-  (some->> @*config*
-           :healthy?
-           (deref)))
+  (or
+    (< (.toMinutes (Duration/ofMillis (.getUptime (ManagementFactory/getRuntimeMXBean)))) 10)
+    (some->> @*config*
+             :healthy?
+             (deref))))
 
 (defn unhealthy?
-  "Returns `true` if there are queues in error, otherwise `false`."
+  "Returns `true` if there are queues in error and application has been up for over 10 minutes, otherwise `false`."
   []
   (false? (healthy?)))
 
@@ -198,6 +201,26 @@
          (sort-by (juxt :qname :status))
          (vec))))
 
+(defn get-errors [qname]
+  (let [{:keys [conn]} @*config*
+        db (d/db conn)]
+    (->> (d/q '[:find [?id ...]
+                :in $ ?qname ?status
+                :where
+                [?e :com.github.ivarref.yoltq/queue-name ?qname]
+                [?e :com.github.ivarref.yoltq/status ?status]
+                [?e :com.github.ivarref.yoltq/id ?id]]
+              db
+              qname
+              :error)
+         (mapv (partial u/get-queue-item db)))))
+
+(defn retry-one-error! [qname]
+  (let [{:keys [handlers] :as cfg} @*config*
+        _ (assert (contains? handlers qname) "Queue not found")
+        cfg (assoc-in cfg [:handlers qname :max-retries] Integer/MAX_VALUE)]
+    (poller/poll-once! cfg qname :error)))
+
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
-- 
cgit v1.2.3


From 4fd3c882e5dbe905711d4aaf8f0e4fe52369cef7 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Thu, 30 Jun 2022 09:52:49 +0200
Subject: Release 0.2.58 Document limitations, alternatives. Improve pr-str
 usage

---
 README.md                             | 48 +++++++++++++++++++++++++++++++++--
 pom.xml                               |  4 +--
 src/com/github/ivarref/yoltq/impl.clj | 12 +++++++--
 3 files changed, 58 insertions(+), 6 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index c62328c..ade8650 100644
--- a/README.md
+++ b/README.md
@@ -211,7 +211,7 @@ is shut down abruptly during processing of queue jobs.
 ### Giving up
 
 A queue job will remain in status `:error` once `:max-retries` (default: 100) have been reached.
-Ideally this will not happen.
+Ideally this will not happen. ¯\\\_(ツ)\_/¯
 
 
 ### All configuration options
@@ -285,6 +285,22 @@ Other than this there is no attempt at ordering the execution of queue jobs.
 In fact the opposite is done in the poller to guard against the case that a single failing queue job
 could effectively take down the entire retry polling job.
 
+## Retrying jobs in the REPL
+
+```clojure
+(require '[com.github.ivarref.yoltq :as yq])
+
+; List jobs that are in state error:
+(yq/get-errors :q)
+
+; This will retry a single job that is in error, regardless 
+; of how many times it has been retried earlier.
+; If the job fails, you will get the full stacktrace on the REPL.
+(yq/retry-one-error! :q)
+; Returns a map containing the new state of the job.
+; Returns nil if there are no (more) jobs in state error for this queue.
+```
+
 # Testing
 
 For testing you will probably want determinism over an extra threadpool
@@ -331,8 +347,35 @@ These dynamic bindings will be in place when yoltq logs errors, warnings
 etc. about failing consumer functions, possibly making troubleshooting
 easier.
 
+## Limitations
+
+Datomic does not have anything like `for update skip locked`.
+Thus consuming a queue should be limited to a single JVM process.
+This library will take queue jobs by compare-and-swapping a lock+state,
+process the item and then compare-and-swapping the lock+new-state.
+It does so eagerly, thus if you have multiple JVM consumers you will
+most likely get many locking conflicts. It should work, but it's far
+from optimal.
+
+## Alternatives
+
+I did not find any alternatives for Datomic.
+
+If I were using PostgreSQL or any other database that supports
+`for update skip locked`, I'd use a queue that uses this.
+For Clojure there is [proletarian](https://github.com/msolli/proletarian).
+
+For Redis there is [carmine](https://github.com/ptaoussanis/carmine).
+
+Note: I have not tried these libraries myself.
+
 ## Change log
 
+#### 2022-06-30 v0.2.58 [diff](https://github.com/ivarref/yoltq/compare/v0.2.57...v0.2.58)
+Slightly more safe EDN printing and parsing.
+Recommended reading:
+[Pitfalls and bumps in Clojure's Extensible Data Notation (EDN)](https://nitor.com/en/articles/pitfalls-and-bumps-clojures-extensible-data-notation-edn)
+
 #### 2022-06-29 v0.2.57 [diff](https://github.com/ivarref/yoltq/compare/v0.2.56...v0.2.57)
 Added `(get-errors qname)` and `(retry-one-error! qname)`.
 
@@ -341,6 +384,7 @@ Improved:
 This was done in order to push new code while a queue was in error in an earlier
 version of the code. In this way rolling upgrades are possible regardless if there
 are queue errors.
+Can you tell that this issue hit me? ¯\\\_(ツ)\_/¯
 
 #### 2022-06-22 v0.2.56 [diff](https://github.com/ivarref/yoltq/compare/v0.2.55...v0.2.56)
 Added support for `:yoltq/queue-id` metadata on functions. I.e. it's possible to write
@@ -420,7 +464,7 @@ First publicly announced release.
 
 ## License
 
-Copyright © 2021 Ivar Refsdal
+Copyright © 2021-2022 Ivar Refsdal
 
 This program and the accompanying materials are made available under the
 terms of the Eclipse Public License 2.0 which is available at
diff --git a/pom.xml b/pom.xml
index 2d992c9..cb293b7 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.57</version>
+  <version>0.2.58</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.57</tag>
+    <tag>v0.2.58</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 6b14ffc..c37b0e6 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -23,11 +23,19 @@
    #:db{:ident :com.github.ivarref.yoltq/error-time, :cardinality :db.cardinality/one, :valueType :db.type/long}
    #:db{:ident :com.github.ivarref.yoltq/version, :cardinality :db.cardinality/one, :valueType :db.type/string, :index true}])
 
+(defn pr-str-inner [x]
+  (binding [*print-dup* false
+            *print-meta* false
+            *print-readably* true
+            *print-length* nil
+            *print-level* nil
+            *print-namespace-maps* false]
+    (pr-str x)))
 
 (defn pr-str-safe [what x]
   (try
-    (if (= x (edn/read-string (pr-str x)))
-      (pr-str x)
+    (if (= x (edn/read-string (pr-str-inner x)))
+      (pr-str-inner x)
       (throw (ex-info (str "Could not read-string " what) {:input x})))
     (catch Exception e
       (log/error "could not read-string" what ":" (ex-message e))
-- 
cgit v1.2.3


From 7d4477c318eefa711c7b7be46fd902419826e4c2 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Mon, 15 Aug 2022 08:37:39 +0200
Subject: Release 0.2.59 Fix slow thread watcher race condition when used with
 stop! https://github.com/ivarref/yoltq/issues/2

---
 pom.xml                                            |   4 +-
 src/com/github/ivarref/yoltq.clj                   | 121 ++++++++++++---------
 .../ivarref/yoltq/slow_executor_detector.clj       |  38 ++++---
 3 files changed, 97 insertions(+), 66 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/pom.xml b/pom.xml
index cb293b7..187b8ad 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.58</version>
+  <version>0.2.59</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.58</tag>
+    <tag>v0.2.59</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index f4c2bf7..32693c3 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -1,17 +1,18 @@
 (ns com.github.ivarref.yoltq
-  (:require [clojure.tools.logging :as log]
-            [com.github.ivarref.yoltq.error-poller :as errpoller]
-            [com.github.ivarref.yoltq.impl :as i]
-            [com.github.ivarref.yoltq.migrate :as migrate]
-            [com.github.ivarref.yoltq.poller :as poller]
-            [com.github.ivarref.yoltq.report-queue :as rq]
-            [com.github.ivarref.yoltq.slow-executor-detector :as slow-executor]
-            [com.github.ivarref.yoltq.utils :as u]
-            [datomic.api :as d])
+  (:require
+    [clojure.tools.logging :as log]
+    [com.github.ivarref.yoltq.error-poller :as errpoller]
+    [com.github.ivarref.yoltq.impl :as i]
+    [com.github.ivarref.yoltq.migrate :as migrate]
+    [com.github.ivarref.yoltq.poller :as poller]
+    [com.github.ivarref.yoltq.report-queue :as rq]
+    [com.github.ivarref.yoltq.slow-executor-detector :as slow-executor]
+    [com.github.ivarref.yoltq.utils :as u]
+    [datomic.api :as d])
   (:import (datomic Connection)
+           (java.lang.management ManagementFactory)
            (java.time Duration)
-           (java.util.concurrent ExecutorService Executors TimeUnit)
-           (java.lang.management ManagementFactory)))
+           (java.util.concurrent ExecutorService Executors TimeUnit)))
 
 
 (defonce ^:dynamic *config* (atom nil))
@@ -70,7 +71,7 @@
 
        ; Should old, possibly stalled jobs be automatically be migrated
        ; as part of `start!`?
-       :auto-migrate? true}
+       :auto-migrate?                 true}
 
       u/duration->millis))
 
@@ -82,10 +83,12 @@
     (let [new-cfg (swap! *config*
                          (fn [old-conf]
                            (-> (merge-with (fn [_ b] b)
-                                           {:running-queues     (atom #{})
-                                            :start-execute-time (atom {})
-                                            :system-error       (atom {})
-                                            :healthy?           (atom nil)}
+                                           {:running-queues            (atom #{})
+                                            :start-execute-time        (atom {})
+                                            :system-error              (atom {})
+                                            :healthy?                  (atom nil)
+                                            :slow?                     (atom nil)
+                                            :slow-thread-watcher-done? (promise)}
                                            default-opts
                                            (if *test-mode* old-conf (select-keys old-conf [:handlers]))
                                            cfg)
@@ -122,17 +125,19 @@
 
 
 (defn- do-start! []
-  (let [{:keys [poll-delay pool-size system-error-poll-delay auto-migrate?] :as cfg} @*config*]
+  (let [{:keys [poll-delay pool-size system-error-poll-delay auto-migrate? slow-thread-watcher-done?] :as cfg} @*config*]
     (when auto-migrate?
       (future (migrate/migrate! cfg)))
-    (reset! threadpool (Executors/newScheduledThreadPool (+ 2 pool-size)))
-    (let [pool @threadpool
+    (let [pool (reset! threadpool (Executors/newScheduledThreadPool (+ 1 pool-size)))
           queue-listener-ready (promise)]
       (reset! *running?* true)
       (.scheduleAtFixedRate pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/MILLISECONDS)
       (.scheduleAtFixedRate pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/MILLISECONDS)
       (.execute pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
-      (.execute pool (fn [] (slow-executor/show-slow-threads *running?* *config*)))
+      (future (try
+                (slow-executor/show-slow-threads pool *config*)
+                (finally
+                  (deliver slow-thread-watcher-done? :done))))
       @queue-listener-ready)))
 
 
@@ -160,23 +165,38 @@
           (do
             (reset! *running?* false)
             (when-let [^ExecutorService tp @threadpool]
-              (log/debug "shutting down old threadpool")
+              (log/debug "shutting down threadpool")
               (.shutdown tp)
               (while (not (.awaitTermination tp 1 TimeUnit/SECONDS))
-                (log/debug "waiting for threadpool to stop"))
+                (log/trace "waiting for threadpool to stop"))
               (log/debug "stopped!")
-              (reset! threadpool nil))))))
+              (reset! threadpool nil))
+            (when-let [wait-slow-threads (some->> *config* deref :slow-thread-watcher-done?)]
+              (log/debug "waiting for slow-thread-watcher to stop ...")
+              @wait-slow-threads
+              (log/debug "waiting for slow-thread-watcher to stop ... OK"))))))
 
 
 (defn healthy? []
-  (or
+  (cond
     (< (.toMinutes (Duration/ofMillis (.getUptime (ManagementFactory/getRuntimeMXBean)))) 10)
-    (some->> @*config*
-             :healthy?
-             (deref))))
+    true
+
+    (false? (some->> @*config*
+                     :healthy?
+                     (deref)))
+    false
+
+    (true? (some->> @*config*
+                    :slow?
+                    (deref)))
+    false
+
+    :else
+    true))
 
 (defn unhealthy?
-  "Returns `true` if there are queues in error and application has been up for over 10 minutes, otherwise `false`."
+  "Returns `true` if there are queues in error or a thread is slow, and the application has been up for over 10 minutes, otherwise `false`."
   []
   (false? (healthy?)))
 
@@ -228,26 +248,29 @@
       [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
        [#{"ivarref.yoltq.report-queue"} :info]
        [#{"ivarref.yoltq.poller"} :info]
-       [#{"ivarref.yoltq*"} :info]
+       [#{"com.github.ivarref.yoltq"} :debug]
+       ;[#{"ivarref.yoltq*"} :info]
        [#{"*"} :info]])
     (stop!)
-    (let [received (atom [])
-          uri (str "datomic:mem://demo")]
-      (d/delete-database uri)
-      (d/create-database uri)
-      (let [ok-items (atom [])
-            conn (d/connect uri)
-            n 1]
-        (init! {:conn               conn
-                :error-backoff-time (Duration/ofSeconds 1)
-                :poll-delay         (Duration/ofSeconds 1)})
-        (add-consumer! :q (fn [payload]
-                            #_(when (> (Math/random) 0.5)
-                                (throw (ex-info "oops" {})))
-                            (if (= n (count (swap! received conj (:work payload))))
-                              (log/info "... and we are done!")
-                              (log/info "got payload" payload "total ok:" (count @received)))))
-        (start!)
-        (dotimes [x n]
-          @(d/transact conn [(put :q {:work 123})]))
-        nil))))
+    (future (let [received (atom [])
+                  uri (str "datomic:mem://demo")]
+              (d/delete-database uri)
+              (d/create-database uri)
+              (let [conn (d/connect uri)
+                    started-consuming? (promise)
+                    n 1]
+                (init! {:conn               conn
+                        :error-backoff-time (Duration/ofSeconds 1)
+                        :poll-delay         (Duration/ofSeconds 1)
+                        :max-execute-time   (Duration/ofSeconds 3)
+                        :slow-thread-show-stacktrace? false})
+                (add-consumer! :q (fn [_]
+                                    (deliver started-consuming? true)
+                                    (log/info "sleeping...")
+                                    (Thread/sleep (.toMillis (Duration/ofSeconds 60)))
+                                    (log/info "done sleeping")))
+                (start!)
+                @(d/transact conn [(put :q {:work 123})])
+                @started-consuming?
+                (stop!)
+                nil)))))
diff --git a/src/com/github/ivarref/yoltq/slow_executor_detector.clj b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
index 80d3718..53dfe89 100644
--- a/src/com/github/ivarref/yoltq/slow_executor_detector.clj
+++ b/src/com/github/ivarref/yoltq/slow_executor_detector.clj
@@ -1,28 +1,36 @@
 (ns com.github.ivarref.yoltq.slow-executor-detector
-  (:require [com.github.ivarref.yoltq.ext-sys :as ext]
+  (:require [clojure.string :as str]
             [clojure.tools.logging :as log]
-            [clojure.string :as str]))
-
+            [com.github.ivarref.yoltq.ext-sys :as ext])
+  (:import (java.util.concurrent ExecutorService)))
 
 (defn- do-show-slow-threads [{:keys [start-execute-time
-                                     max-execute-time]}]
-  (doseq [[^Thread thread [start-time queue-id queue-name]] @start-execute-time]
-    (when (> (ext/now-ms) (+ start-time max-execute-time))
-      (log/error "thread" (.getName thread) "spent too much time on"
-                 "queue item" (str queue-id)
-                 "for queue" queue-name
-                 "stacktrace: \n"
-                 (str/join "\n" (mapv str (seq (.getStackTrace thread))))))))
-
+                                     max-execute-time
+                                     slow?
+                                     slow-thread-show-stacktrace?]
+                              :or {slow-thread-show-stacktrace? true}}]
+  (let [new-slow-val (atom false)]
+    (doseq [[^Thread thread [start-time queue-id queue-name]] @start-execute-time]
+      (when (> (ext/now-ms) (+ start-time max-execute-time))
+        (reset! new-slow-val true)
+        (log/error "thread" (.getName thread) "spent too much time on"
+                   "queue item" (str queue-id)
+                   "for queue" queue-name
+                   (if slow-thread-show-stacktrace?
+                       (str "stacktrace: \n" (str/join "\n" (mapv str (seq (.getStackTrace thread)))))
+                       ""))))
+    (reset! slow? @new-slow-val)))
 
-(defn show-slow-threads [running? config-atom]
+(defn show-slow-threads [^ExecutorService pool config-atom]
   (try
-    (while @running?
+    (while (not (.isTerminated pool))
       (try
         (do-show-slow-threads @config-atom)
         (catch Throwable t
           (log/error t "do-show-slow-threads crashed:" (ex-message t))))
       (dotimes [_ 3]
-        (when @running? (Thread/sleep 1000))))
+        (when (not (.isTerminated pool))
+          (Thread/sleep 1000))))
+    (log/debug "show-slow-threads exiting")
     (catch Throwable t
       (log/error t "reap! crashed:" (ex-message t)))))
-- 
cgit v1.2.3


From 812a07b3b9f2d212f80499433b638fb5b4a78f70 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Thu, 18 Aug 2022 13:00:02 +0200
Subject: Release 0.2.60 Warn about not setting connection/socket-timeout when
 using clj-http https://github.com/ivarref/yoltq/issues/2

Add :healthy-allowed-error-time configuration option, default is 15 minutes
---
 README.md                                          | 28 +++++++++++++++--
 pom.xml                                            |  4 +--
 src/com/github/ivarref/yoltq.clj                   | 14 ++++++---
 src/com/github/ivarref/yoltq/error_poller.clj      | 36 +++++++++++++---------
 .../com/github/ivarref/yoltq/error_poller_test.clj |  8 ++---
 test/com/github/ivarref/yoltq/virtual_test.clj     | 15 ++++++++-
 6 files changed, 77 insertions(+), 28 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index ade8650..05e7033 100644
--- a/README.md
+++ b/README.md
@@ -62,18 +62,25 @@ Imagine the following code:
 ```clojure
 (defn post-handler [user-input]
   (let [db-item (process user-input)
-        ext-ref (clj-http.client/post ext-service {...})] ; may throw exception
+        ext-ref (clj-http.client/post ext-service {:connection-timeout 3000  ; timeout in milliseconds 
+                                                   :socket-timeout     10000 ; timeout in milliseconds
+                                                   ...})] ; may throw exception
     @(d/transact conn [(assoc db-item :some/ext-ref ext-ref)])))
 ```
 
 What if the POST request fails? Should it be retried? For how long?
 Should it be allowed to fail? How do you then process failures later?
 
+PS: If you do not set connection/socket-timeout, there is a chance that
+clj-http/client will wait for all eternity in the case of a dropped TCP connection.
+
 The queue way to solve this would be:
 
 ```clojure
 (defn get-ext-ref [{:keys [id]}]
-  (let [ext-ref (clj-http.client/post ext-service {...})] ; may throw exception
+  (let [ext-ref (clj-http.client/post ext-service {:connection-timeout 3000  ; timeout in milliseconds 
+                                                   :socket-timeout     10000 ; timeout in milliseconds
+                                                   ...})] ; may throw exception
     @(d/transact conn [[:db/cas [:some/id id]
                         :some/ext-ref
                         nil
@@ -82,7 +89,7 @@ The queue way to solve this would be:
 (yq/add-consumer! :get-ext-ref get-ext-ref {:allow-cas-failure? true})
 
 (defn post-handler [user-input]
-  (let [{:some/keys [id] :as db-item} (process user-input)
+  (let [{:some/keys [id] :as db-item} (process user-input)]
     @(d/transact conn [db-item
                        (yq/put :get-ext-ref {:id id})])))
 ```
@@ -371,6 +378,21 @@ Note: I have not tried these libraries myself.
 
 ## Change log
 
+#### 2022-08-18 v0.2.60 [diff](https://github.com/ivarref/yoltq/compare/v0.2.59...v0.2.60)
+Improved: Added config option `:healthy-allowed-error-time`:
+```
+    ; If you are dealing with a flaky downstream service, you may not want
+    ; yoltq to mark itself as unhealthy on the first failure encounter with
+    ; the downstream service. Change this setting to let yoltq mark itself
+    ; as healthy even though a queue item has been failing for some time.
+    :healthy-allowed-error-time    (Duration/ofMinutes 15)
+```
+
+#### 2022-08-15 v0.2.59 [diff](https://github.com/ivarref/yoltq/compare/v0.2.58...v0.2.59)
+Fixed:
+* Race condition that made the following possible: `stop!` would terminate the slow thread 
+watcher, and a stuck thread could keep `stop!` from completing! 
+
 #### 2022-06-30 v0.2.58 [diff](https://github.com/ivarref/yoltq/compare/v0.2.57...v0.2.58)
 Slightly more safe EDN printing and parsing.
 Recommended reading:
diff --git a/pom.xml b/pom.xml
index 187b8ad..719b0e7 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.59</version>
+  <version>0.2.60</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.59</tag>
+    <tag>v0.2.60</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 32693c3..89112a6 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -44,6 +44,12 @@
        ; otherwise occur if competing with the tx-report-queue listener.
        :init-backoff-time             (Duration/ofSeconds 60)
 
+       ; If you are dealing with a flaky downstream service, you may not want
+       ; yoltq to mark itself as unhealthy on the first failure encounter with
+       ; the downstream service. Change this setting to let yoltq mark itself
+       ; as healthy even though a queue item has been failing for some time.
+       :healthy-allowed-error-time    (Duration/ofMinutes 15)
+
        ; How frequent polling for init, error and hung jobs should be done.
        :poll-delay                    (Duration/ofSeconds 10)
 
@@ -259,10 +265,10 @@
               (let [conn (d/connect uri)
                     started-consuming? (promise)
                     n 1]
-                (init! {:conn               conn
-                        :error-backoff-time (Duration/ofSeconds 1)
-                        :poll-delay         (Duration/ofSeconds 1)
-                        :max-execute-time   (Duration/ofSeconds 3)
+                (init! {:conn                         conn
+                        :error-backoff-time           (Duration/ofSeconds 1)
+                        :poll-delay                   (Duration/ofSeconds 1)
+                        :max-execute-time             (Duration/ofSeconds 3)
                         :slow-thread-show-stacktrace? false})
                 (add-consumer! :q (fn [_]
                                     (deliver started-consuming? true)
diff --git a/src/com/github/ivarref/yoltq/error_poller.clj b/src/com/github/ivarref/yoltq/error_poller.clj
index ee6359e..dffff28 100644
--- a/src/com/github/ivarref/yoltq/error_poller.clj
+++ b/src/com/github/ivarref/yoltq/error_poller.clj
@@ -1,8 +1,8 @@
 (ns com.github.ivarref.yoltq.error-poller
-  (:require [datomic.api :as d]
-            [com.github.ivarref.yoltq.utils :as u]
+  (:require [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq.ext-sys :as ext]
-            [clojure.tools.logging :as log]))
+            [com.github.ivarref.yoltq.utils :as u]
+            [datomic.api :as d]))
 
 
 (defn get-state [v]
@@ -64,31 +64,39 @@
             {:run-callback :recovery}))))))
 
 
-(defn do-poll-errors [{:keys [conn system-error
+(defn do-poll-errors [{:keys [conn
+                              system-error
                               on-system-error
                               on-system-recovery
-                              healthy?]
+                              healthy?
+                              healthy-allowed-error-time]
                        :or   {on-system-error    (fn []
                                                    (log/error "There are yoltq queues which have errors")
                                                    nil)
                               on-system-recovery (fn []
                                                    (log/info "Yoltq recovered"))}
-                       :as   config}]
+                       :as   config}
+                      now-ms]
   (assert (some? conn) "expected :conn to be present")
   (assert (some? system-error) "expected :system-error to be present")
-  (let [error-count (or (d/q '[:find (count ?e) .
-                               :in $ ?status
+  (assert (nat-int? healthy-allowed-error-time) "expected :healthy-allowed-error-time to be present")
+  (let [max-init-time (- now-ms healthy-allowed-error-time)
+        error-count (or (d/q '[:find (count ?e) .
+                               :in $ ?status ?max-init-time
                                :where
-                               [?e :com.github.ivarref.yoltq/status ?status]]
+                               [?e :com.github.ivarref.yoltq/status ?status]
+                               [?e :com.github.ivarref.yoltq/init-time ?init-time]
+                               [(<= ?init-time ?max-init-time)]]
                              (d/db conn)
-                             u/status-error)
+                             u/status-error
+                             max-init-time)
                         0)]
     (if (pos-int? error-count)
       (do
         (log/debug "poll-errors found" error-count "errors in system")
         (reset! healthy? false))
       (reset! healthy? true))
-    (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config (ext/now-ms) error-count)]
+    (let [{:keys [run-callback] :as new-state} (swap! system-error handle-error-count config now-ms error-count)]
       (when run-callback
         (cond (= run-callback :error)
               (on-system-error)
@@ -99,18 +107,18 @@
               :else
               (log/error "unhandled callback-type" run-callback))
         (log/debug "run-callback is" run-callback))
-      new-state)))
+      error-count)))
 
 
 (defn poll-errors [running? config-atom]
   (try
     (when @running?
-      (do-poll-errors @config-atom))
+      (do-poll-errors @config-atom (ext/now-ms)))
     (catch Throwable t
       (log/error t "unexpected error in poll-errors:" (ex-message t))
       nil)))
 
 
 (comment
-  (do-poll-errors @com.github.ivarref.yoltq/*config*))
+  (do-poll-errors @com.github.ivarref.yoltq/*config* (ext/now-ms)))
 
diff --git a/test/com/github/ivarref/yoltq/error_poller_test.clj b/test/com/github/ivarref/yoltq/error_poller_test.clj
index 18f0aa7..4d92b81 100644
--- a/test/com/github/ivarref/yoltq/error_poller_test.clj
+++ b/test/com/github/ivarref/yoltq/error_poller_test.clj
@@ -1,9 +1,9 @@
 (ns com.github.ivarref.yoltq.error-poller-test
-  (:require [clojure.test :refer [deftest is]]
-            [com.github.ivarref.yoltq.error-poller :as ep]
+  (:require [clojure.edn :as edn]
+            [clojure.test :refer [deftest is]]
             [clojure.tools.logging :as log]
-            [com.github.ivarref.yoltq.log-init :as logconfig]
-            [clojure.edn :as edn]))
+            [com.github.ivarref.yoltq.error-poller :as ep]
+            [com.github.ivarref.yoltq.log-init :as logconfig]))
 
 
 (deftest error-poller
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index e077517..996792e 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -2,6 +2,8 @@
   (:require [clojure.test :refer [deftest is use-fixtures] :refer-macros [thrown?]]
             [clojure.tools.logging :as log]
             [com.github.ivarref.yoltq :as yq]
+            [com.github.ivarref.yoltq.error-poller :as error-poller]
+            [com.github.ivarref.yoltq.ext-sys :as ext]
             [com.github.ivarref.yoltq.impl :as i]
             [com.github.ivarref.yoltq.migrate :as migrate]
             [com.github.ivarref.yoltq.test-queue :as tq]
@@ -9,7 +11,8 @@
             [com.github.ivarref.yoltq.utils :as uu]
             [datomic-schema.core]
             [datomic.api :as d]
-            [taoensso.timbre :as timbre]))
+            [taoensso.timbre :as timbre])
+  (:import (java.time Duration)))
 
 
 (use-fixtures :each tq/call-with-virtual-queue!)
@@ -367,3 +370,13 @@
     (is (= #{{:id "a"}} @received))
     #_(timbre/with-level :fatal
                          (is (thrown? Exception @(d/transact conn [(yq/put :q {})]))))))
+
+(deftest healthy-allowed-error-time-test
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [_] (throw (ex-info "" {}))))
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (tq/consume-expect! :q :error)
+    (is (= 0 (error-poller/do-poll-errors @yq/*config* (ext/now-ms))))
+    (is (= 0 (error-poller/do-poll-errors @yq/*config* (+ (dec (.toMillis (Duration/ofMinutes 15))) (ext/now-ms)))))
+    (is (= 1 (error-poller/do-poll-errors @yq/*config* (+ (.toMillis (Duration/ofMinutes 15)) (ext/now-ms)))))))
-- 
cgit v1.2.3


From c7b74e242a51fc0db92cc7eb264a569a3f1edde8 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Wed, 7 Sep 2022 16:37:01 +0200
Subject: Release 0.2.61 Add function retry-stats

---
 README.md                        | 28 +++++++++++++++++++++++
 pom.xml                          |  4 ++--
 src/com/github/ivarref/yoltq.clj | 49 +++++++++++++++++++++++++++++++++++++++-
 3 files changed, 78 insertions(+), 3 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 05e7033..1c0d3da 100644
--- a/README.md
+++ b/README.md
@@ -378,6 +378,34 @@ Note: I have not tried these libraries myself.
 
 ## Change log
 
+#### 2022-09-07 v0.2.61 [diff](https://github.com/ivarref/yoltq/compare/v0.2.60...v0.2.61)
+Added function option `retry-stats`:
+
+```clojure
+(ns com.github.ivarref.yoltq)
+
+(defn retry-stats
+  "Gather retry statistics.
+
+  Optional keyword arguments:
+  * :age-days —  last number of days to look at data from. Defaults to 30.
+  * :queue-name — only gather statistics for this queue name. Defaults to nil, meaning all queues.
+
+  Example return value:
+  {:queue-a {:ok 100, :retries 2, :retry-percentage 2.0}
+   :queue-b {:ok 100, :retries 75, :retry-percentage 75.0}}
+
+  From the example value above, we can see that :queue-b fails at a much higher rate than :queue-a.
+  Assuming that the queue consumers are correctly implemented, this means that the service representing :queue-b
+  is much more unstable than the one representing :queue-a. This again implies
+  that you will probably want to fix the downstream service of :queue-b, if that is possible.
+  "
+  [{:keys [age-days queue-name now]
+    :or   {age-days 30
+           now      (ZonedDateTime/now ZoneOffset/UTC)}}]
+  ...)
+```
+
 #### 2022-08-18 v0.2.60 [diff](https://github.com/ivarref/yoltq/compare/v0.2.59...v0.2.60)
 Improved: Added config option `:healthy-allowed-error-time`:
 ```
diff --git a/pom.xml b/pom.xml
index 719b0e7..775df3d 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.60</version>
+  <version>0.2.61</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.60</tag>
+    <tag>v0.2.61</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 89112a6..4eba4e9 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -11,7 +11,7 @@
     [datomic.api :as d])
   (:import (datomic Connection)
            (java.lang.management ManagementFactory)
-           (java.time Duration)
+           (java.time Duration Instant ZoneOffset ZonedDateTime)
            (java.util.concurrent ExecutorService Executors TimeUnit)))
 
 
@@ -247,6 +247,53 @@
         cfg (assoc-in cfg [:handlers qname :max-retries] Integer/MAX_VALUE)]
     (poller/poll-once! cfg qname :error)))
 
+(defn retry-stats
+  "Gather retry statistics.
+
+  Optional keyword arguments:
+  * :age-days —  last number of days to look at data from. Defaults to 30.
+  * :queue-name — only gather statistics for this queue name. Defaults to nil, meaning all queues.
+
+  Example return value:
+  {:queue-a {:ok 100, :retries 2, :retry-percentage 2.0}
+   :queue-b {:ok 100, :retries 75, :retry-percentage 75.0}}
+
+  From the example value above, we can see that :queue-b fails at a much higher rate than :queue-a.
+  Assuming that the queue consumers are correctly implemented, this means that the service representing :queue-b
+  is much more unstable than the one representing :queue-a. This again implies
+  that you will probably want to fix the downstream service of :queue-b, if that is possible.
+  "
+  [{:keys [age-days queue-name now]
+    :or   {age-days 30
+           now      (ZonedDateTime/now ZoneOffset/UTC)}}]
+  (let [{:keys [conn]} @*config*
+        db (d/db conn)]
+    (->> (d/query {:query {:find  '[?qname ?status ?tries ?init-time]
+                           :in    (into '[$] (when queue-name '[?qname]))
+                           :where '[[?e :com.github.ivarref.yoltq/queue-name ?qname]
+                                    [?e :com.github.ivarref.yoltq/status ?status]
+                                    [?e :com.github.ivarref.yoltq/tries ?tries]
+                                    [?e :com.github.ivarref.yoltq/init-time ?init-time]]}
+                   :args  (remove nil? [db queue-name])})
+         (mapv (partial zipmap [:qname :status :tries :init-time]))
+         (mapv #(update % :init-time (fn [init-time] (.atZone (Instant/ofEpochMilli init-time) ZoneOffset/UTC))))
+         (mapv #(assoc % :age-days (.toDays (Duration/between (:init-time %) now))))
+         (filter #(<= (:age-days %) age-days))
+         (group-by :qname)
+         (mapv (fn [[q values]]
+                 {q (let [{:keys [ok retries] :as m} (->> values
+                                                          (mapv (fn [{:keys [tries status]}]
+                                                                  (condp = status
+                                                                    u/status-init {}
+                                                                    u/status-processing {:processing 1 :retries (dec tries)}
+                                                                    u/status-done {:ok 1 :retries (dec tries)}
+                                                                    u/status-error {:error 1 :retries (dec tries)})))
+                                                          (reduce (partial merge-with +) {}))]
+                      (into (sorted-map) (merge m
+                                                (when (pos-int? ok)
+                                                  {:retry-percentage (double (* 100 (/ retries ok)))}))))}))
+         (into (sorted-map)))))
+
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
-- 
cgit v1.2.3


From f3fc5f7ab037aba728bf376c087e466b2fbf12db Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Tue, 15 Nov 2022 18:42:30 +0100
Subject: Release 0.2.62: Add function processing-time-stats

---
 README.md                        | 38 +++++++++++++++++++++++-
 pom.xml                          |  4 +--
 release.sh                       | 11 ++++---
 src/com/github/ivarref/yoltq.clj | 64 ++++++++++++++++++++++++++++++++++++++--
 4 files changed, 108 insertions(+), 9 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 1c0d3da..63b9ad3 100644
--- a/README.md
+++ b/README.md
@@ -378,8 +378,44 @@ Note: I have not tried these libraries myself.
 
 ## Change log
 
+#### 2022-11-15 v0.2.62 [diff](https://github.com/ivarref/yoltq/compare/v0.2.61...v0.2.62)
+Added function `processing-time-stats`:
+
+```clojure
+(ns com.github.ivarref.yoltq)
+
+(defn processing-time-stats
+  "Gather processing time statistics.
+
+  Optional keyword arguments:
+  * :age-days —  last number of days to look at data from. Defaults to 30.
+                 Use nil to have no limit.
+
+  * :queue-name — only gather statistics for this queue name. Defaults to nil, meaning all queues.
+
+  * :duration->long - Specify what unit should be used for values.
+                      Must take a java.time.Duration as input and return a long.
+
+                      Defaults to (fn [duration] (.toSeconds duration).
+                      I.e. the default unit is seconds.
+
+  Example return value:
+  {:queue-a {:avg 1
+             :max 10
+             :min 0
+             :p50 ...
+             :p90 ...
+             :p95 ...
+             :p99 ...}}"
+ [{:keys [age-days queue-name now db duration->long]
+  :or   {age-days 30
+         now      (ZonedDateTime/now ZoneOffset/UTC)
+         duration->long (fn [duration] (.toSeconds duration))}}]
+  ...)
+```
+
 #### 2022-09-07 v0.2.61 [diff](https://github.com/ivarref/yoltq/compare/v0.2.60...v0.2.61)
-Added function option `retry-stats`:
+Added function `retry-stats`:
 
 ```clojure
 (ns com.github.ivarref.yoltq)
diff --git a/pom.xml b/pom.xml
index 775df3d..2c11984 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.61</version>
+  <version>0.2.62</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -30,7 +30,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.61</tag>
+    <tag>v0.2.62</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/release.sh b/release.sh
index d27d125..3d06135 100755
--- a/release.sh
+++ b/release.sh
@@ -1,5 +1,10 @@
 #!/bin/bash
 
+if [[ $# -ne 1 ]]; then
+    echo "Illegal number of parameters" >&2
+    exit 2
+fi
+
 set -ex
 
 git update-index --refresh
@@ -23,11 +28,9 @@ sed -i "s/HEAD/v$VERSION/g" ./README.md
 git add pom.xml README.md
 git commit -m "Release $VERSION"
 git reset --soft HEAD~2
-git commit -m"Release $VERSION
-$MSG"
+git commit -m"Release $VERSION: $1"
 
-git tag -a v"$VERSION" -m "Release v$VERSION
-$MSG"
+git tag -a v"$VERSION" -m "Release v$VERSION: $1"
 git push --follow-tags --force
 
 clojure -X:deploy
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 4eba4e9..9ffb3ad 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -263,11 +263,11 @@
   is much more unstable than the one representing :queue-a. This again implies
   that you will probably want to fix the downstream service of :queue-b, if that is possible.
   "
-  [{:keys [age-days queue-name now]
+  [{:keys [age-days queue-name now db]
     :or   {age-days 30
            now      (ZonedDateTime/now ZoneOffset/UTC)}}]
   (let [{:keys [conn]} @*config*
-        db (d/db conn)]
+        db (or db (d/db conn))]
     (->> (d/query {:query {:find  '[?qname ?status ?tries ?init-time]
                            :in    (into '[$] (when queue-name '[?qname]))
                            :where '[[?e :com.github.ivarref.yoltq/queue-name ?qname]
@@ -294,6 +294,66 @@
                                                   {:retry-percentage (double (* 100 (/ retries ok)))}))))}))
          (into (sorted-map)))))
 
+(defn- percentile [n values]
+  (let [idx (int (Math/floor (* (count values) (/ n 100))))]
+    (nth values idx)))
+
+(defn processing-time-stats
+  "Gather processing time statistics. Default unit is seconds.
+
+  Optional keyword arguments:
+  * :age-days —  last number of days to look at data from. Defaults to 30.
+                 Use nil to have no limit.
+
+  * :queue-name — only gather statistics for this queue name. Defaults to nil, meaning all queues.
+
+  * :duration->long - Specify what unit should be used for values.
+                      Must take a java.time.Duration as input and return a long.
+
+                      Defaults to (fn [duration] (.toSeconds duration).
+                      I.e. the default unit is seconds.
+
+  Example return value:
+  {:queue-a {:avg 1
+             :max 10
+             :min 0
+             :p50 ...
+             :p90 ...
+             :p95 ...
+             :p99 ...}}"
+  [{:keys [age-days queue-name now db duration->long]
+    :or   {age-days 30
+           now      (ZonedDateTime/now ZoneOffset/UTC)
+           duration->long (fn [duration] (.toSeconds duration))}}]
+  (let [{:keys [conn]} @*config*
+        db (or db (d/db conn))
+        ->zdt #(.atZone (Instant/ofEpochMilli %) ZoneOffset/UTC)]
+    (->> (d/query {:query {:find  '[?qname ?status ?init-time ?done-time]
+                           :in    (into '[$ ?status] (when queue-name '[?qname]))
+                           :where '[[?e :com.github.ivarref.yoltq/queue-name ?qname]
+                                    [?e :com.github.ivarref.yoltq/status ?status]
+                                    [?e :com.github.ivarref.yoltq/init-time ?init-time]
+                                    [?e :com.github.ivarref.yoltq/done-time ?done-time]]}
+                   :args  (vec (remove nil? [db u/status-done queue-name]))})
+         (mapv (partial zipmap [:qname :status :init-time :done-time]))
+         (mapv #(update % :init-time ->zdt))
+         (mapv #(update % :done-time ->zdt))
+         (mapv #(assoc % :age-days (.toDays (Duration/between (:init-time %) now))))
+         (mapv #(assoc % :spent-time (duration->long (Duration/between (:init-time %) (:done-time %)))))
+         (filter #(or (nil? age-days) (<= (:age-days %) age-days)))
+         (group-by :qname)
+         (mapv (fn [[q values]]
+                 (let [values (vec (sort (mapv :spent-time values)))]
+                   {q (sorted-map
+                        :max (apply max values)
+                        :avg (int (Math/floor (/ (reduce + 0 values) (count values))))
+                        :p50 (percentile 50 values)
+                        :p90 (percentile 90 values)
+                        :p95 (percentile 95 values)
+                        :p99 (percentile 99 values)
+                        :min (apply min values))})))
+         (into (sorted-map)))))
+
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
-- 
cgit v1.2.3


From 8f945d8c0189ad73d862c988faa511e0a7b017df Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Fri, 18 Nov 2022 14:12:50 +0100
Subject: Release 0.2.63: Add support for :encode and :decode function. Add
 :partition-fn. Fixes #1

---
 README.md                                      | 65 ++++++++++++++++-
 deps.edn                                       |  6 +-
 pom.xml                                        |  9 ++-
 src/com/github/ivarref/yoltq/impl.clj          | 95 +++++++++++++++----------
 src/com/github/ivarref/yoltq/utils.clj         |  1 -
 test/com/github/ivarref/yoltq/virtual_test.clj | 98 ++++++++++++++++++++++----
 6 files changed, 218 insertions(+), 56 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 63b9ad3..a914cc7 100644
--- a/README.md
+++ b/README.md
@@ -131,7 +131,8 @@ Inspecting `(yq/put :q {:work 123})]` you will see something like this:
 
 This is the queue job as it will be stored into the database. 
 You can see that the payload, i.e. the second argument of `yq/put`,
-is persisted into the database. Thus the payload must be `pr-str`-able.
+is persisted into the database. Thus the payload must be `pr-str`-able (unless you have specified
+custom `:encode` and `:decode` functions that override this).
 
 
 A queue job will initially have status `:init`.
@@ -220,6 +221,47 @@ is shut down abruptly during processing of queue jobs.
 A queue job will remain in status `:error` once `:max-retries` (default: 100) have been reached.
 Ideally this will not happen. ¯\\\_(ツ)\_/¯
 
+### Custom encoding and decoding
+
+Yoltq will use `pr-str` and `clojure.edn/read-string` by default to encode and decode data.
+You may specify `:encode` and `:decode` either globally or per queue to override this behaviour.
+The `:encode` function must return a byte array or a string.
+
+For example if you want to use [nippy](https://github.com/ptaoussanis/nippy):
+```clojure
+(require '[taoensso.nippy :as nippy])
+
+; Globally for all queues:
+(yq/init!
+  {:conn conn
+   :encode nippy/freeze
+   :decode nippy/thaw})
+
+; Or per queue:
+(yq/add-consumer! 
+  :q ; Queue to consume  
+  (fn [payload] (println "got payload:" payload)) ; Queue consumer function
+  {:encode nippy/freeze
+   :decode nippy/thaw}) ; Queue options, here with :encode and :decode
+```
+
+### Partitions
+
+Yoltq supports specifying which [partition](https://docs.datomic.com/on-prem/schema/schema.html#partitions)
+queue entities should belong to.
+The default function is:
+```clojure
+(defn default-partition-fn [_queue-name]
+  (keyword "yoltq" (str "queue_" (.getValue (java.time.Year/now)))))
+```
+This is to say that there will be a single partition per year for yoltq.
+Yoltq will take care of creating the partition if it does not exist.
+
+You may override this function, either globally or per queue, with the keyword `:partition-fn`.
+E.g.:
+```clojure
+(yq/init! {:conn conn :partition-fn (fn [_queue-name] :my-partition)})
+```
 
 ### All configuration options
 
@@ -376,8 +418,29 @@ For Redis there is [carmine](https://github.com/ptaoussanis/carmine).
 
 Note: I have not tried these libraries myself.
 
+## Other stuff
+
+If you liked this library, you may also like:
+
+* [conformity](https://github.com/avescodes/conformity): A Clojure/Datomic library for idempotently transacting norms into your database – be they schema, data, or otherwise.
+* [datomic-schema](https://github.com/ivarref/datomic-schema): Simplified writing of Datomic schemas (works with conformity).
+* [double-trouble](https://github.com/ivarref/double-trouble):  Handle duplicate Datomic transactions with ease.
+* [gen-fn](https://github.com/ivarref/gen-fn): Generate Datomic function literals from regular Clojure namespaces.
+* [rewriting-history](https://github.com/ivarref/rewriting-history): A library to rewrite Datomic history.
+
 ## Change log
 
+#### 2022-11-18 v0.2.63 [diff](https://github.com/ivarref/yoltq/compare/v0.2.62...v0.2.63)
+Added custom `:encode` and `:decode` support.
+
+Added support for specifying `:partifion-fn` to specify which partition a queue item should belong to.
+It defaults to:
+```clojure
+(defn default-partition-fn [_queue-name]
+  (keyword "yoltq" (str "queue_" (.getValue (Year/now)))))
+```
+Yoltq takes care of creating the partition if it does not exist.
+
 #### 2022-11-15 v0.2.62 [diff](https://github.com/ivarref/yoltq/compare/v0.2.61...v0.2.62)
 Added function `processing-time-stats`:
 
diff --git a/deps.edn b/deps.edn
index 6923881..e36885e 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,5 +1,6 @@
-{:deps      {org.clojure/tools.logging {:mvn/version "1.2.4"}
-             org.clojure/clojure       {:mvn/version "1.11.1"}}
+{:deps      {com.github.ivarref/double-trouble {:mvn/version "0.1.102"}
+             org.clojure/tools.logging         {:mvn/version "1.2.4"}
+             org.clojure/clojure               {:mvn/version "1.11.1"}}
 
  :paths     ["src"]
 
@@ -11,6 +12,7 @@
                                      clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"}
                                      com.datomic/datomic-pro                 {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}
                                      org.postgresql/postgresql               {:mvn/version "9.3-1102-jdbc41"}
+                                     com.taoensso/nippy                      {:mvn/version "3.2.0"}
                                      io.github.cognitect-labs/test-runner    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
                        :jvm-opts    ["-DDISABLE_SPY=true"
                                      "-DTAOENSSO_TIMBRE_MIN_LEVEL_EDN=:error"]
diff --git a/pom.xml b/pom.xml
index 2c11984..463899d 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.62</version>
+  <version>0.2.63</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -12,6 +12,11 @@
       <artifactId>clojure</artifactId>
       <version>1.11.1</version>
     </dependency>
+    <dependency>
+      <groupId>com.github.ivarref</groupId>
+      <artifactId>double-trouble</artifactId>
+      <version>0.1.102</version>
+    </dependency>
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>tools.logging</artifactId>
@@ -30,7 +35,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.62</tag>
+    <tag>v0.2.63</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index c37b0e6..ac573d1 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -1,11 +1,12 @@
 (ns com.github.ivarref.yoltq.impl
-  (:require [datomic.api :as d]
-            [clojure.tools.logging :as log]
+  (:require [clojure.edn :as edn]
             [clojure.string :as str]
-            [com.github.ivarref.yoltq.utils :as u]
+            [clojure.tools.logging :as log]
+            [com.github.ivarref.double-trouble :as dt]
             [com.github.ivarref.yoltq.ext-sys :as ext]
-            [clojure.edn :as edn]))
-
+            [com.github.ivarref.yoltq.utils :as u]
+            [datomic.api :as d])
+  (:import (java.time Year)))
 
 (def schema
   [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
@@ -13,6 +14,7 @@
    #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
+   #:db{:ident :com.github.ivarref.yoltq/payload-bytes, :cardinality :db.cardinality/one, :valueType :db.type/bytes}
    #:db{:ident :com.github.ivarref.yoltq/opts, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/bindings, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/tries, :cardinality :db.cardinality/one, :valueType :db.type/long, :noHistory true}
@@ -41,13 +43,22 @@
       (log/error "could not read-string" what ":" (ex-message e))
       (throw e))))
 
+(defn default-partition-fn [_queue-keyword]
+  (keyword "yoltq" (str "queue_" (.getValue (Year/now)))))
 
-(defn put [{:keys [capture-bindings conn] :as config}
+(defn put [{:keys [capture-bindings conn encode partition-fn]
+            :or   {partition-fn default-partition-fn
+                   encode       (partial pr-str-safe :payload)}
+            :as   config}
            queue-name
            payload
            opts]
   (if-let [q-config (get-in config [:handlers queue-name])]
     (let [id (u/squuid)
+          encode (get q-config :encode encode)
+          partition-fn (get q-config :partition-fn partition-fn)
+          partition (partition-fn queue-name)
+          _ (assert (keyword? partition) "Partition must be a keyword")
           depends-on (get q-config :depends-on (fn [_] nil))
           valid-payload? (get q-config :valid-payload? (fn [_] true))
           opts (merge
@@ -58,32 +69,41 @@
                                       (assoc o (symbol k) (deref k)))
                                     {}
                                     (or capture-bindings []))
-                            (pr-str-safe :capture-bindings))]
-      (when-not (valid-payload? payload)
-        (log/error "Payload was not valid. Payload was:" payload)
-        (throw (ex-info (str "Payload was not valid: " payload) {:payload payload})))
+                            (pr-str-safe :capture-bindings))
+          _ (when-not (valid-payload? payload)
+              (log/error "Payload was not valid. Payload was:" payload)
+              (throw (ex-info (str "Payload was not valid: " payload) {:payload payload})))
+          encoded (encode payload)
+          _ (when (not (or (bytes? encoded) (string? encoded)))
+              (log/error "Payload must be encoded to either a string or a byte array")
+              (throw (ex-info (str "Payload must be encoded to a string or a byte array. Payload: " payload) {:payload payload})))]
       (log/debug "queue item" (str id) "for queue" queue-name "is pending status" u/status-init)
-      (merge
-        {:com.github.ivarref.yoltq/id         id
-         :com.github.ivarref.yoltq/queue-name queue-name
-         :com.github.ivarref.yoltq/status     u/status-init
-         :com.github.ivarref.yoltq/payload    (pr-str-safe :payload payload)
-         :com.github.ivarref.yoltq/bindings   str-bindings
-         :com.github.ivarref.yoltq/opts       (pr-str-safe :opts opts)
-         :com.github.ivarref.yoltq/lock       (u/random-uuid)
-         :com.github.ivarref.yoltq/tries      0
-         :com.github.ivarref.yoltq/init-time  (u/now-ms)
-         :com.github.ivarref.yoltq/version    "2"}
-        (when-let [[q ext-id] (:depends-on opts)]
-          (when-not (d/q '[:find ?e .
-                           :in $ ?ext-id
-                           :where
-                           [?e :com.github.ivarref.yoltq/ext-id ?ext-id]]
-                         (d/db conn)
-                         (pr-str-safe :depends-on [q ext-id]))
-            (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
-        (when-let [ext-id (:id opts)]
-          {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})))
+      (do
+        (dt/ensure-partition! conn partition)
+        (merge
+          (if (bytes? encoded)
+            {:com.github.ivarref.yoltq/payload-bytes encoded}
+            {:com.github.ivarref.yoltq/payload encoded})
+          {:db/id                               (d/tempid partition)
+           :com.github.ivarref.yoltq/id         id
+           :com.github.ivarref.yoltq/queue-name queue-name
+           :com.github.ivarref.yoltq/status     u/status-init
+           :com.github.ivarref.yoltq/bindings   str-bindings
+           :com.github.ivarref.yoltq/opts       (pr-str-safe :opts opts)
+           :com.github.ivarref.yoltq/lock       (u/random-uuid)
+           :com.github.ivarref.yoltq/tries      0
+           :com.github.ivarref.yoltq/init-time  (u/now-ms)
+           :com.github.ivarref.yoltq/version    "2"}
+          (when-let [[q ext-id] (:depends-on opts)]
+            (when-not (d/q '[:find ?e .
+                             :in $ ?ext-id
+                             :where
+                             [?e :com.github.ivarref.yoltq/ext-id ?ext-id]]
+                           (d/db conn)
+                           (pr-str-safe :depends-on [q ext-id]))
+              (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
+          (when-let [ext-id (:id opts)]
+            {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])}))))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
@@ -169,20 +189,23 @@
                  "in" (format "%.1f" (double (/ spent-ns 1e6))) "ms"]))
 
 
-(defn execute! [{:keys [handlers mark-status-fn! start-execute-time collect-spent-time!]
-                 :or   {mark-status-fn! mark-status!}
+(defn execute! [{:keys [decode handlers mark-status-fn! start-execute-time collect-spent-time!]
+                 :or   {mark-status-fn! mark-status!
+                        decode          edn/read-string}
                  :as   cfg}
-                {:com.github.ivarref.yoltq/keys [status id queue-name payload] :as queue-item}]
+                {:com.github.ivarref.yoltq/keys [status id queue-name payload payload-bytes] :as queue-item}]
   (when queue-item
     (if (= :error status)
       (assoc queue-item :failed? true)
       (if-let [queue (get handlers queue-name)]
-        (let [{:keys [f allow-cas-failure?]} queue]
+        (let [{:keys [f allow-cas-failure?]} queue
+              decode (get queue :decode decode)]
           (log/debug "queue item" (str id) "for queue" queue-name "is now processing")
           (let [{:keys [retval exception]}
                 (try
                   (swap! start-execute-time assoc (Thread/currentThread) [(ext/now-ms) id queue-name])
-                  (let [v (f payload)]
+                  (let [payload (decode (or payload payload-bytes))
+                        v (f payload)]
                     {:retval v})
                   (catch Throwable t
                     {:exception t})
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index 39572a9..7665b6d 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -57,7 +57,6 @@
 (defn get-queue-item [db id]
   (-> (d/pull db '[:*] [:com.github.ivarref.yoltq/id id])
       (dissoc :db/id)
-      (update :com.github.ivarref.yoltq/payload edn/read-string)
       (update :com.github.ivarref.yoltq/opts (fn [s] (or (when s (edn/read-string s)) {})))
       (update :com.github.ivarref.yoltq/bindings
               (fn [s]
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 996792e..2800c21 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -1,18 +1,21 @@
 (ns com.github.ivarref.yoltq.virtual-test
-  (:require [clojure.test :refer [deftest is use-fixtures] :refer-macros [thrown?]]
-            [clojure.tools.logging :as log]
-            [com.github.ivarref.yoltq :as yq]
-            [com.github.ivarref.yoltq.error-poller :as error-poller]
-            [com.github.ivarref.yoltq.ext-sys :as ext]
-            [com.github.ivarref.yoltq.impl :as i]
-            [com.github.ivarref.yoltq.migrate :as migrate]
-            [com.github.ivarref.yoltq.test-queue :as tq]
-            [com.github.ivarref.yoltq.test-utils :as u]
-            [com.github.ivarref.yoltq.utils :as uu]
-            [datomic-schema.core]
-            [datomic.api :as d]
-            [taoensso.timbre :as timbre])
-  (:import (java.time Duration)))
+  (:require
+    [clojure.string :as str]
+    [clojure.test :refer [deftest is use-fixtures] :refer-macros [thrown?]]
+    [clojure.tools.logging :as log]
+    [com.github.ivarref.yoltq :as yq]
+    [com.github.ivarref.yoltq.error-poller :as error-poller]
+    [com.github.ivarref.yoltq.ext-sys :as ext]
+    [com.github.ivarref.yoltq.impl :as i]
+    [com.github.ivarref.yoltq.migrate :as migrate]
+    [com.github.ivarref.yoltq.test-queue :as tq]
+    [com.github.ivarref.yoltq.test-utils :as u]
+    [com.github.ivarref.yoltq.utils :as uu]
+    [datomic-schema.core]
+    [datomic.api :as d]
+    [taoensso.nippy :as nippy]
+    [taoensso.timbre :as timbre])
+  (:import (java.time Duration LocalDateTime)))
 
 
 (use-fixtures :each tq/call-with-virtual-queue!)
@@ -380,3 +383,70 @@
     (is (= 0 (error-poller/do-poll-errors @yq/*config* (ext/now-ms))))
     (is (= 0 (error-poller/do-poll-errors @yq/*config* (+ (dec (.toMillis (Duration/ofMinutes 15))) (ext/now-ms)))))
     (is (= 1 (error-poller/do-poll-errors @yq/*config* (+ (.toMillis (Duration/ofMinutes 15)) (ext/now-ms)))))))
+
+(deftest global-encode-decode
+  (let [conn (u/empty-conn)
+        ldt (LocalDateTime/now)
+        got-work (atom nil)]
+    (yq/init! {:conn conn
+               :encode nippy/freeze
+               :decode nippy/thaw})
+    (yq/add-consumer! :q (fn [work] (reset! got-work work)))
+    @(d/transact conn [(yq/put :q {:work ldt})])
+    (tq/consume! :q)
+    (is (= @got-work {:work ldt}))))
+
+(deftest queue-encode-decode
+  (let [conn (u/empty-conn)
+        ldt (LocalDateTime/now)
+        got-work (atom nil)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [work] (reset! got-work work))
+                      {:encode nippy/freeze
+                       :decode nippy/thaw})
+    @(d/transact conn [(yq/put :q {:work ldt})])
+    (tq/consume! :q)
+    (is (= @got-work {:work ldt}))))
+
+(deftest global-partition
+  (let [conn (u/empty-conn)
+        got-work (atom nil)]
+    (yq/init! {:conn conn
+               :partition-fn (fn [_queue-name] :my-part)})
+    (yq/add-consumer! :q (fn [work] (reset! got-work work)))
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (tq/consume! :q)
+    (is (some? (d/q '[:find ?e .
+                      :in $ ?part
+                      :where
+                      [?e :db/ident ?part]]
+                    (d/db conn)
+                    :my-part)))
+    (is (= @got-work {:work 123}))))
+
+(deftest partition-per-queue
+  (let [conn (u/empty-conn)
+        got-work (atom nil)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q (fn [work] (reset! got-work work))
+                      {:partition-fn (fn [_queue-name] :my-part)})
+    @(d/transact conn [(yq/put :q {:work 123})])
+    (tq/consume! :q)
+    (is (some? (d/q '[:find ?e .
+                      :in $ ?part
+                      :where
+                      [?e :db/ident ?part]]
+                    (d/db conn)
+                    :my-part)))
+    (is (= @got-work {:work 123}))))
+
+(deftest string-encode-decode
+  (let [conn (u/empty-conn)
+        got-work (atom nil)]
+    (yq/init! {:conn   conn
+               :encode (fn [x] (str/join (reverse x)))
+               :decode (fn [x] (str/join (reverse x)))})
+    (yq/add-consumer! :q (fn [work] (reset! got-work work)))
+    @(d/transact conn [(yq/put :q "asdf")])
+    (tq/consume! :q)
+    (is (= @got-work "asdf"))))
-- 
cgit v1.2.3


From e848610ac341db31b804644a7dfaaf98389469d5 Mon Sep 17 00:00:00 2001
From: Ivar Refsdal <refsdal.ivar@gmail.com>
Date: Mon, 20 Mar 2023 12:24:00 +0100
Subject: Release 0.2.64: Allow for infinitive retries

---
 README.md                              | 16 +++++++++++++---
 pom.xml                                |  4 ++--
 src/com/github/ivarref/yoltq.clj       |  7 +++++--
 src/com/github/ivarref/yoltq/utils.clj | 17 +++++++++++------
 4 files changed, 31 insertions(+), 13 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index a914cc7..c5f2bdb 100644
--- a/README.md
+++ b/README.md
@@ -156,7 +156,9 @@ the payload. It can be added like this:
                             ; consumer function to ensure idempotence.
    :valid-payload? (fn [payload] (some? (:id payload))) ; Function that verifies payload. Should return truthy for valid payloads.
                                                         ; The default function always returns true.
-   :max-retries 10})        ; Specify maximum number of times an item will be retried. Default: 100
+   :max-retries 10})        ; Specify maximum number of times an item will be retried. Default: 10000.
+                            ; If :max-retries is given as 0, the job will ~always be retried, i.e.
+                            ; 9223372036854775807 times (Long/MAX_VALUE).
 ```
 
 The `payload` will be deserialized from the database using `clojure.edn/read-string` before invocation, i.e.
@@ -218,8 +220,10 @@ is shut down abruptly during processing of queue jobs.
 
 ### Giving up
 
-A queue job will remain in status `:error` once `:max-retries` (default: 100) have been reached.
-Ideally this will not happen. ¯\\\_(ツ)\_/¯
+A queue job will remain in status `:error` once `:max-retries` (default: 10000) have been reached.
+If `:max-retries` is given as `0`, the job will be retried 9223372036854775807 times before
+giving up.
+Ideally this should not happen. ¯\\\_(ツ)\_/¯
 
 ### Custom encoding and decoding
 
@@ -430,6 +434,12 @@ If you liked this library, you may also like:
 
 ## Change log
 
+#### 2023-03-20 v0.2.64 [diff](https://github.com/ivarref/yoltq/compare/v0.2.63...v0.2.64)
+Added support for `max-retries` being `0`, meaning the job should be retried forever
+(or at least 9223372036854775807 times).
+
+Changed the default for `max-retries` from `100` to `10000`.
+
 #### 2022-11-18 v0.2.63 [diff](https://github.com/ivarref/yoltq/compare/v0.2.62...v0.2.63)
 Added custom `:encode` and `:decode` support.
 
diff --git a/pom.xml b/pom.xml
index 463899d..466f47a 100644
--- a/pom.xml
+++ b/pom.xml
@@ -4,7 +4,7 @@
   <packaging>jar</packaging>
   <groupId>com.github.ivarref</groupId>
   <artifactId>yoltq</artifactId>
-  <version>0.2.63</version>
+  <version>0.2.64</version>
   <name>yoltq</name>
   <dependencies>
     <dependency>
@@ -35,7 +35,7 @@
   <scm>
     <connection>scm:git:git://github.com/ivarref/yoltq.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/ivarref/yoltq.git</developerConnection>
-    <tag>v0.2.63</tag>
+    <tag>v0.2.64</tag>
     <url>https://github.com/ivarref/yoltq</url>
   </scm>
 </project>
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 9ffb3ad..379d701 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -24,7 +24,10 @@
   (-> {; Default number of times a queue job will be retried before giving up
        ; Can be overridden on a per-consumer basis with
        ; (yq/add-consumer! :q (fn [payload] ...) {:max-retries 200})
-       :max-retries                   100
+       ; If you want no limit on the number of retries, specify
+       ; the value `0`. That will set the effective retry limit to
+       ; 9223372036854775807 times.
+       :max-retries                   10000
 
        ; Minimum amount of time to wait before a failed queue job is retried
        :error-backoff-time            (Duration/ofSeconds 5)
@@ -244,7 +247,7 @@
 (defn retry-one-error! [qname]
   (let [{:keys [handlers] :as cfg} @*config*
         _ (assert (contains? handlers qname) "Queue not found")
-        cfg (assoc-in cfg [:handlers qname :max-retries] Integer/MAX_VALUE)]
+        cfg (assoc-in cfg [:handlers qname :max-retries] Long/MAX_VALUE)]
     (poller/poll-once! cfg qname :error)))
 
 (defn retry-stats
diff --git a/src/com/github/ivarref/yoltq/utils.clj b/src/com/github/ivarref/yoltq/utils.clj
index 7665b6d..9defd0e 100644
--- a/src/com/github/ivarref/yoltq/utils.clj
+++ b/src/com/github/ivarref/yoltq/utils.clj
@@ -103,13 +103,18 @@
         (prepare-processing db id queue-name old-lock :init))
       (log/debug "no new-items in :init status for queue" queue-name))))
 
+(defn- get-max-retries [cfg queue-name]
+  (let [v (get-in cfg [:handlers queue-name :max-retries] (:max-retries cfg))]
+    (if (and (number? v) (pos-int? v))
+      v
+      Long/MAX_VALUE)))
 
-(defn get-error [{:keys [conn db error-backoff-time max-retries] :as cfg} queue-name]
+(defn get-error [{:keys [conn db error-backoff-time] :as cfg} queue-name]
   (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
   (let [db (or db (d/db conn))
-        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)]
+        max-retries (get-max-retries cfg queue-name)]
     (when-let [ids (->> (d/q '[:find ?id ?lock
                                :in $ ?queue-name ?backoff ?max-tries ?current-version
                                :where
@@ -118,26 +123,26 @@
                                [?e :com.github.ivarref.yoltq/error-time ?time]
                                [(>= ?backoff ?time)]
                                [?e :com.github.ivarref.yoltq/tries ?tries]
-                               [(> ?max-tries ?tries)]
+                               [(>= ?max-tries ?tries)]
                                [?e :com.github.ivarref.yoltq/id ?id]
                                [?e :com.github.ivarref.yoltq/lock ?lock]
                                [?e :com.github.ivarref.yoltq/version ?current-version]]
                              db
                              queue-name
                              (- (now-ms) error-backoff-time)
-                             (inc max-retries)
+                             max-retries
                              current-version)
                         (not-empty))]
       (let [[id old-lock] (rand-nth (into [] ids))]
         (prepare-processing db id queue-name old-lock :error)))))
 
 
-(defn get-hung [{:keys [conn db now hung-backoff-time max-retries] :as cfg} queue-name]
+(defn get-hung [{:keys [conn db now hung-backoff-time] :as cfg} queue-name]
   (assert (instance? Connection conn) (str "Expected conn to be of type datomic.Connection. Was: "
                                            (str (if (nil? conn) "nil" conn))
                                            "\nConfig was: " (str cfg)))
   (let [now (or now (now-ms))
-        max-retries (get-in cfg [:handlers queue-name :max-retries] max-retries)
+        max-retries (get-max-retries cfg queue-name)
         db (or db (d/db conn))]
     (when-let [ids (->> (d/q '[:find ?id ?lock ?tries
                                :in $ ?qname ?backoff ?current-version
-- 
cgit v1.2.3


From 85d13545275678a1077b9600fce136ae10dcb809 Mon Sep 17 00:00:00 2001
From: Stefan van den Oord <stefan@medicinemen.eu>
Date: Fri, 14 Jun 2024 16:08:59 +0200
Subject: #3 Add optional batch name to queue jobs

---
 src/com/github/ivarref/yoltq.clj               | 23 +++++++++++++++++++++++
 src/com/github/ivarref/yoltq/impl.clj          |  5 ++++-
 test/com/github/ivarref/yoltq/virtual_test.clj | 22 ++++++++++++++++++++++
 3 files changed, 49 insertions(+), 1 deletion(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 379d701..1ba286e 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -230,6 +230,29 @@
          (sort-by (juxt :qname :status))
          (vec))))
 
+(defn batch-progress [queue-name batch-name]
+  (let [{:keys [conn]} @*config*
+        db (d/db conn)]
+    (->> (d/q '[:find ?e ?qname ?bname ?status
+                :keys :e :qname :bname :status
+                :in $ ?qname ?bname
+                :where
+                [?e :com.github.ivarref.yoltq/queue-name ?qname]
+                [?e :com.github.ivarref.yoltq/batch-name ?bname]
+                [?e :com.github.ivarref.yoltq/status ?status]]
+              db queue-name batch-name)
+         (mapv #(select-keys % [:qname :bname :status]))
+         (mapv (fn [qitem] {qitem 1}))
+         (reduce (partial merge-with +) {})
+         (mapv (fn [[{:keys [qname bname status]} v]]
+                 (array-map
+                  :qname qname
+                  :batch-name bname
+                  :status status
+                  :count v)))
+         (sort-by (juxt :qname :batch-name :status))
+         (vec))))
+
 (defn get-errors [qname]
   (let [{:keys [conn]} @*config*
         db (d/db conn)]
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index ac573d1..6d2aa3d 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -12,6 +12,7 @@
   [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
    #:db{:ident :com.github.ivarref.yoltq/ext-id, :cardinality :db.cardinality/one, :valueType :db.type/string, :unique :db.unique/value}
    #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
+   #:db{:ident :com.github.ivarref.yoltq/batch-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/payload-bytes, :cardinality :db.cardinality/one, :valueType :db.type/bytes}
@@ -103,7 +104,9 @@
                            (pr-str-safe :depends-on [q ext-id]))
               (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
           (when-let [ext-id (:id opts)]
-            {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])}))))
+            {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})
+          (when-let [batch-name (:batch-name opts)]
+            {:com.github.ivarref.yoltq/batch-name batch-name}))))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 2800c21..7621b13 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -450,3 +450,25 @@
     @(d/transact conn [(yq/put :q "asdf")])
     (tq/consume! :q)
     (is (= @got-work "asdf"))))
+
+(deftest batch-of-jobs-test
+  (let [conn (u/empty-conn)]
+    (yq/init! {:conn conn})
+    (yq/add-consumer! :q1 identity)
+    (yq/add-consumer! :q2 identity)
+    @(d/transact conn [(yq/put :q1 {:work 123} {:batch-name :b1})
+                       (yq/put :q1 {:work 456} {:batch-name :b2})
+                       (yq/put :q2 {:work 789} {:batch-name :b1})])
+    (is (= [{:qname :q1
+             :batch-name :b1
+             :status :init
+             :count 1}]
+           (yq/batch-progress :q1 :b1)))
+
+    (is (= {:work 123} (tq/consume! :q1)))
+
+    (is (= [{:qname :q1
+             :batch-name :b1
+             :status :done
+             :count 1}]
+           (yq/batch-progress :q1 :b1)))))
-- 
cgit v1.2.3


From 1df100143cf935cca10f0afa62ef00f2673c655a Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Tue, 13 May 2025 19:02:10 +0200
Subject: Fix reflection warnings

---
 src/com/github/ivarref/yoltq.clj | 25 ++++++++++++++++++-------
 1 file changed, 18 insertions(+), 7 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 379d701..a7dcddf 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -12,8 +12,7 @@
   (:import (datomic Connection)
            (java.lang.management ManagementFactory)
            (java.time Duration Instant ZoneOffset ZonedDateTime)
-           (java.util.concurrent ExecutorService Executors TimeUnit)))
-
+           (java.util.concurrent ExecutorService Executors ScheduledExecutorService TimeUnit)))
 
 (defonce ^:dynamic *config* (atom nil))
 (defonce threadpool (atom nil))
@@ -85,7 +84,7 @@
       u/duration->millis))
 
 
-(defn init! [{:keys [conn] :as cfg}]
+(defn init! [{:keys [conn tx-report-queue] :as cfg}]
   (assert (instance? Connection conn) (str "Expected :conn to be of type datomic Connection. Was: " (or (some-> conn class str) "nil")))
   (locking threadpool
     @(d/transact conn i/schema)
@@ -97,6 +96,9 @@
                                             :system-error              (atom {})
                                             :healthy?                  (atom nil)
                                             :slow?                     (atom nil)
+                                            :get-tx-report-queue       (fn []
+                                                                         (or tx-report-queue
+                                                                             (d/tx-report-queue conn)))
                                             :slow-thread-watcher-done? (promise)}
                                            default-opts
                                            (if *test-mode* old-conf (select-keys old-conf [:handlers]))
@@ -140,9 +142,9 @@
     (let [pool (reset! threadpool (Executors/newScheduledThreadPool (+ 1 pool-size)))
           queue-listener-ready (promise)]
       (reset! *running?* true)
-      (.scheduleAtFixedRate pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/MILLISECONDS)
-      (.scheduleAtFixedRate pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/MILLISECONDS)
-      (.execute pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
+      (.scheduleAtFixedRate ^ScheduledExecutorService pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/MILLISECONDS)
+      (.scheduleAtFixedRate ^ScheduledExecutorService pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/MILLISECONDS)
+      (.execute ^ScheduledExecutorService pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
       (future (try
                 (slow-executor/show-slow-threads pool *config*)
                 (finally
@@ -327,7 +329,7 @@
   [{:keys [age-days queue-name now db duration->long]
     :or   {age-days 30
            now      (ZonedDateTime/now ZoneOffset/UTC)
-           duration->long (fn [duration] (.toSeconds duration))}}]
+           duration->long (fn [duration] (.toSeconds ^Duration duration))}}]
   (let [{:keys [conn]} @*config*
         db (or db (d/db conn))
         ->zdt #(.atZone (Instant/ofEpochMilli %) ZoneOffset/UTC)]
@@ -357,6 +359,15 @@
                         :min (apply min values))})))
          (into (sorted-map)))))
 
+
+
+(defn add-tx-report-queue!
+  ([conn]
+   (add-tx-report-queue! conn :default))
+  ([conn id]
+   (if @*config*
+     :...)))
+
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
-- 
cgit v1.2.3


From ae49a7ec82ecd3988e0f7825b0adead1dc77c911 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Tue, 13 May 2025 21:39:07 +0200
Subject: Fix tx-report-queue sharing #7

---
 README.md                                     |  34 +++++++
 deps.edn                                      |  54 +++++------
 src/com/github/ivarref/yoltq.clj              |  86 ++++++++++++++---
 src/com/github/ivarref/yoltq/report_queue.clj | 133 ++++++++++++++++++++++++--
 test/com/github/ivarref/yoltq/log_init.clj    |   2 +
 5 files changed, 258 insertions(+), 51 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index c5f2bdb..f84a336 100644
--- a/README.md
+++ b/README.md
@@ -434,6 +434,40 @@ If you liked this library, you may also like:
 
 ## Change log
 
+#### 2025-05-13 v0.2.?? [diff](https://github.com/ivarref/yoltq/compare/v0.2.64...HEAD)
+Added support for specifying `tx-report-queue` as a keyword in `init!`. Yoltq will
+then not grab the datomic report queue, but use the one provided: 
+
+```clojure
+(require '[com.github.ivarref.yoltq :as yq])
+(yq/init! {:conn            conn
+           :tx-report-queue (yq/get-tx-report-queue-multicast! my-conn :yoltq)
+                            ; ^^ can be any `java.util.concurrent.BlockingQueue` value
+                            })
+
+(another-tx-report-consumer! (yq/get-tx-report-queue-multicast! my-conn :another-consumer-id))
+
+```
+
+Added multicast support for `datomic.api/tx-report-queue`:
+```clojure
+(def my-q1 (yq/get-tx-report-queue-multicast! my-conn :q-id-1))
+; ^^ consume my-q1 just like you would do `datomic.api/tx-report-queue`
+
+(def my-q2 (yq/get-tx-report-queue-multicast! my-conn :q-id-2))
+; Both my-q1 and my-q2 will receive everything from `datomic.api/tx-report-queue`
+```
+
+`yq/get-tx-report-queue-multicast!` returns, like
+`datomic.api/tx-report-queue`,
+`java.util.concurrent.BlockingQueue` and starts a background thread that does 
+the multicasting as needed. Identical calls to `yq/get-tx-report-queue-multicast!`
+returns the same `BlockingQueue`.
+
+Changed the default for `max-retries` from `10000` to `9223372036854775807`.
+
+Fixed reflection warnings.
+
 #### 2023-03-20 v0.2.64 [diff](https://github.com/ivarref/yoltq/compare/v0.2.63...v0.2.64)
 Added support for `max-retries` being `0`, meaning the job should be retried forever
 (or at least 9223372036854775807 times).
diff --git a/deps.edn b/deps.edn
index e36885e..1e3fa9d 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,33 +1,31 @@
-{:deps      {com.github.ivarref/double-trouble {:mvn/version "0.1.102"}
-             org.clojure/tools.logging         {:mvn/version "1.2.4"}
-             org.clojure/clojure               {:mvn/version "1.11.1"}}
+{:deps    {com.github.ivarref/double-trouble {:mvn/version "0.1.102"}
+           org.clojure/tools.logging         {:mvn/version "1.2.4"}
+           org.clojure/clojure               {:mvn/version "1.11.1"}
+           com.datomic/peer                  {:mvn/version "1.0.7364"}}
 
- :paths     ["src"]
+ :paths   ["src"]
 
- :aliases   {:datomic {:extra-deps {com.datomic/datomic-pro {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}}}
-             :test    {:extra-paths ["test"]
-                       :extra-deps  {ivarref/datomic-schema                  {:mvn/version "0.2.0"}
-                                     com.taoensso/timbre                     {:mvn/version "5.2.1"}
-                                     com.fzakaria/slf4j-timbre               {:mvn/version "0.3.21"}
-                                     clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"}
-                                     com.datomic/datomic-pro                 {:mvn/version "1.0.6316" :exclusions [org.slf4j/slf4j-nop]}
-                                     org.postgresql/postgresql               {:mvn/version "9.3-1102-jdbc41"}
-                                     com.taoensso/nippy                      {:mvn/version "3.2.0"}
-                                     io.github.cognitect-labs/test-runner    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
-                       :jvm-opts    ["-DDISABLE_SPY=true"
-                                     "-DTAOENSSO_TIMBRE_MIN_LEVEL_EDN=:error"]
-                       :main-opts   ["--report" "stderr" "-m" "cognitect.test-runner"]}
+ :aliases {:test    {:extra-paths ["test"]
+                     :extra-deps  {ivarref/datomic-schema                  {:mvn/version "0.2.0"}
+                                   com.taoensso/timbre                     {:mvn/version "5.2.1"}
+                                   com.fzakaria/slf4j-timbre               {:mvn/version "0.3.21"}
+                                   clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"}
+                                   org.postgresql/postgresql               {:mvn/version "9.3-1102-jdbc41"}
+                                   com.taoensso/nippy                      {:mvn/version "3.2.0"}
+                                   io.github.cognitect-labs/test-runner    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
+                     :exec-fn     cognitect.test-runner.api/test
+                     :jvm-opts    ["-DDISABLE_SPY=true"
+                                   "-DTAOENSSO_TIMBRE_MIN_LEVEL_EDN=:error"]
+                     :main-opts   ["--report" "stderr" "-m" "cognitect.test-runner"]}
 
-             :jar     {:extra-deps {pack/pack.alpha {:git/url "https://github.com/juxt/pack.alpha.git"
-                                                     :sha     "0e8731e0f24db05b74769e219051b0e92b50624a"}}
-                       :main-opts  ["-m" "mach.pack.alpha.skinny" "--no-libs" "--project-path" "target/out.jar"]}
+           :jar     {:extra-deps {pack/pack.alpha {:git/url "https://github.com/juxt/pack.alpha.git"
+                                                   :sha     "0e8731e0f24db05b74769e219051b0e92b50624a"}}
+                     :main-opts  ["-m" "mach.pack.alpha.skinny" "--no-libs" "--project-path" "target/out.jar"]}
 
-             :release {:extra-deps {ivarref/pom-patch {:mvn/version "0.1.16"}}}
+           :release {:extra-deps {ivarref/pom-patch {:mvn/version "0.1.16"}}}
 
-             :deploy  {:extra-deps {slipset/deps-deploy {:mvn/version "0.2.0"}}
-                       :exec-fn    deps-deploy.deps-deploy/deploy
-                       :exec-args  {:installer      :remote
-                                    :sign-releases? false
-                                    :artifact       "target/out.jar"}}}
-
- :mvn/repos {"my.datomic.com" {:url "https://my.datomic.com/repo"}}}
+           :deploy  {:extra-deps {slipset/deps-deploy {:mvn/version "0.2.0"}}
+                     :exec-fn    deps-deploy.deps-deploy/deploy
+                     :exec-args  {:installer      :remote
+                                  :sign-releases? false
+                                  :artifact       "target/out.jar"}}}}
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index a7dcddf..32298b7 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -12,7 +12,7 @@
   (:import (datomic Connection)
            (java.lang.management ManagementFactory)
            (java.time Duration Instant ZoneOffset ZonedDateTime)
-           (java.util.concurrent ExecutorService Executors ScheduledExecutorService TimeUnit)))
+           (java.util.concurrent BlockingQueue ExecutorService Executors ScheduledExecutorService TimeUnit)))
 
 (defonce ^:dynamic *config* (atom nil))
 (defonce threadpool (atom nil))
@@ -26,7 +26,7 @@
        ; If you want no limit on the number of retries, specify
        ; the value `0`. That will set the effective retry limit to
        ; 9223372036854775807 times.
-       :max-retries                   10000
+       :max-retries                   9223372036854775807
 
        ; Minimum amount of time to wait before a failed queue job is retried
        :error-backoff-time            (Duration/ofSeconds 5)
@@ -86,6 +86,9 @@
 
 (defn init! [{:keys [conn tx-report-queue] :as cfg}]
   (assert (instance? Connection conn) (str "Expected :conn to be of type datomic Connection. Was: " (or (some-> conn class str) "nil")))
+  (when (some? tx-report-queue)
+    (assert (instance? BlockingQueue tx-report-queue)
+            (str "Expected :tx-report-queue to be of type java.util.concurrent.BlockingQueue")))
   (locking threadpool
     @(d/transact conn i/schema)
     (let [new-cfg (swap! *config*
@@ -96,9 +99,6 @@
                                             :system-error              (atom {})
                                             :healthy?                  (atom nil)
                                             :slow?                     (atom nil)
-                                            :get-tx-report-queue       (fn []
-                                                                         (or tx-report-queue
-                                                                             (d/tx-report-queue conn)))
                                             :slow-thread-watcher-done? (promise)}
                                            default-opts
                                            (if *test-mode* old-conf (select-keys old-conf [:handlers]))
@@ -144,12 +144,37 @@
       (reset! *running?* true)
       (.scheduleAtFixedRate ^ScheduledExecutorService pool (fn [] (poller/poll-all-queues! *running?* *config* pool)) 0 poll-delay TimeUnit/MILLISECONDS)
       (.scheduleAtFixedRate ^ScheduledExecutorService pool (fn [] (errpoller/poll-errors *running?* *config*)) 0 system-error-poll-delay TimeUnit/MILLISECONDS)
-      (.execute ^ScheduledExecutorService pool (fn [] (rq/report-queue-listener *running?* queue-listener-ready pool *config*)))
+      (.execute ^ScheduledExecutorService pool
+                (fn []
+                  (try
+                    (log/debug "report-queue-listener starting")
+                    (rq/report-queue-listener *running?* queue-listener-ready pool *config*)
+                    (finally
+                      (log/debug "report-queue-listener exiting")
+                      (deliver queue-listener-ready :finally)))))
       (future (try
                 (slow-executor/show-slow-threads pool *config*)
                 (finally
                   (deliver slow-thread-watcher-done? :done))))
-      @queue-listener-ready)))
+      (let [q-listener-retval (deref queue-listener-ready 30000 :timeout)]
+        (cond (= :timeout q-listener-retval)
+              (do
+                (log/error "Timed out waiting for report-queue-listener to start")
+                (throw (IllegalStateException. "Timed out waiting for report-queue-listener to start")))
+
+              (= :finally q-listener-retval)
+              (do
+                (log/error "report-queue-listener did not start")
+                (throw (IllegalStateException. "report-queue-listener did not start")))
+
+              (= :ready q-listener-retval)
+              (do
+                (log/debug "report-queue-listener is ready"))
+
+              :else
+              (do
+                (log/error (str "Unexpected queue-listener-retval: " (pr-str q-listener-retval)))
+                (throw (IllegalStateException. (str "Unexpected queue-listener-retval: " (pr-str q-listener-retval))))))))))
 
 
 (defn start! []
@@ -359,14 +384,13 @@
                         :min (apply min values))})))
          (into (sorted-map)))))
 
+(defn get-tx-report-queue-multicast!
+  "Multicast the datomic.api/tx-report-queue to different consumers.
+  The multicaster is started on demand. `conn` and `id` identifies the consumer.
 
-
-(defn add-tx-report-queue!
-  ([conn]
-   (add-tx-report-queue! conn :default))
-  ([conn id]
-   (if @*config*
-     :...)))
+  Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
+  [conn id]
+  (rq/get-tx-report-queue-multicast! conn id))
 
 (comment
   (do
@@ -401,3 +425,37 @@
                 @started-consuming?
                 (stop!)
                 nil)))))
+
+(comment
+  (do
+    (require 'com.github.ivarref.yoltq.log-init)
+    (com.github.ivarref.yoltq.log-init/init-logging!
+      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
+       [#{"com.github.ivarref.yoltq.report-queue"} :debug]
+       [#{"com.github.ivarref.yoltq.poller"} :info]
+       [#{"com.github.ivarref.yoltq.migrate"} :warn]
+       [#{"com.github.ivarref.yoltq"} :debug]
+       ;[#{"ivarref.yoltq*"} :info]
+       [#{"*"} :info]])
+    (stop!)
+    (let [received (atom [])
+          uri (str "datomic:mem://demo")]
+      (d/delete-database uri)
+      (d/create-database uri)
+      (let [conn (d/connect uri)
+            started-consuming? (promise)
+            n 1]
+        (init! {:conn                         conn
+                :tx-report-queue (get-tx-report-queue-multicast! conn :yoltq)
+                :slow-thread-show-stacktrace? false})
+        (add-consumer! :q (fn [_]
+                            (deliver started-consuming? true)))
+        (log/info "begin start! ...")
+        (start!)
+        (log/info "begin start! ... Done")
+        (Thread/sleep 2000)
+        @(d/transact conn [(put :q {:work 123})])
+        @started-consuming?
+        (stop!)
+        (log/info "stop! done")
+        nil))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index 20e0a93..9cddc93 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -3,8 +3,8 @@
             [com.github.ivarref.yoltq.impl :as i]
             [datomic.api :as d]
             [clojure.tools.logging :as log])
-  (:import (datomic Datom)
-           (java.util.concurrent ScheduledExecutorService BlockingQueue TimeUnit)))
+  (:import (datomic Connection Datom)
+           (java.util.concurrent LinkedBlockingQueue ScheduledExecutorService BlockingQueue TimeUnit)))
 
 
 (defn process-poll-result! [cfg id-ident poll-result consumer]
@@ -28,18 +28,24 @@
                               (i/take! cfg)
                               (i/execute! cfg)))))
                       (catch Throwable t
-                        (log/error t "unexpected error in process-poll-result!")))))))))
+                        (log/error t "Unexpected error in process-poll-result!")))))))))
 
 
 (defn report-queue-listener [running?
                              ready?
                              ^ScheduledExecutorService pool
                              config-atom]
-  (let [conn (:conn @config-atom)
-        ^BlockingQueue q (d/tx-report-queue conn)
+  (let [cfg @config-atom
+        conn (:conn cfg)
+        tx-report-queue-given (contains? cfg :tx-report-queue)
+        ^BlockingQueue q (if tx-report-queue-given
+                           (get cfg :tx-report-queue)
+                           (d/tx-report-queue conn))
         id-ident (d/q '[:find ?e .
                         :where [?e :db/ident :com.github.ivarref.yoltq/id]]
                       (d/db conn))]
+    (assert (instance? BlockingQueue q))
+    (log/debug "tx-report-queue-given:" tx-report-queue-given)
     (try
       (while @running?
         (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
@@ -49,9 +55,118 @@
                                 (fn [f]
                                   (when @running?
                                     (.execute ^ScheduledExecutorService pool f)))))
-        (deliver ready? true))
+        (deliver ready? :ready))
       (catch Throwable t
-        (log/error t "unexpected error in report-queue-listener"))
+        (log/error t "Unexpected error in report-queue-listener:" (.getMessage t)))
       (finally
-        (log/debug "remove tx-report-queue")
-        (d/remove-tx-report-queue conn)))))
\ No newline at end of file
+        (if tx-report-queue-given
+          (log/debug "Remove tx-report-queue handled elsewhere")
+          (do
+            (log/debug "Remove tx-report-queue")
+            (d/remove-tx-report-queue conn)))))))
+
+(defonce ^:private multicast-state-lock (Object.))
+
+(defonce ^:private multicast-state (atom {}))
+
+(defn- start-multicaster! [conn]
+  (let [multicaster-ready? (promise)]
+    (future
+      (log/debug "Multicaster starting for conn" conn)
+      (try
+        (let [input-queue (d/tx-report-queue conn)]
+          (loop []
+            (when-let [mcast-state (get @multicast-state conn)]
+              (when-let [dest-queues (vals mcast-state)]
+                (let [element (.poll ^BlockingQueue input-queue 1 TimeUnit/SECONDS)]
+                  (deliver multicaster-ready? :ready)
+                  (when (some? element)
+                    (doseq [q dest-queues]
+                      (let [ok-offer (.offer ^BlockingQueue q element 30 TimeUnit/MINUTES)]
+                        (when (false? ok-offer)
+                          (log/error "Failed to offer item in multicaster for connection" conn))))))
+                (recur)))))
+        (catch Throwable t
+          (deliver multicaster-ready? :error)
+          (log/error t "Unexpected error in multicaster:" (.getMessage t)))
+        (finally
+          (d/remove-tx-report-queue conn)
+          (log/debug "Multicaster exiting for conn" conn))))
+    multicaster-ready?))
+
+(defn get-tx-report-queue-multicast!
+  "Multicast the datomic.api/tx-report-queue to different consumers.
+  The multicaster is started on demand. `conn` and `id` identifies the consumer.
+
+  Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
+  [conn id]
+  (assert (instance? Connection conn))
+  (assert (keyword? id))
+  (locking multicast-state-lock
+    (assert (map? @multicast-state))
+    (if-let [existing-q (get-in @multicast-state [conn id])]
+      (do
+        (log/debug "returning existing queue for id" id)
+        (assert (instance? BlockingQueue existing-q))
+        existing-q)
+      (let [needs-multicaster? (not (contains? @multicast-state conn))
+            new-state (swap! multicast-state (fn [old-state] (assoc-in old-state [conn id] (LinkedBlockingQueue.))))]
+        (when needs-multicaster?
+          (let [multicaster-promise (start-multicaster! conn)
+                multicaster-result (deref multicaster-promise (* 30 60000) :timeout)]
+            (cond (= multicaster-result :timeout)
+                  (do
+                    (log/error "Timeout waiting for multicaster to start")
+                    (throw (RuntimeException. "Timeout waiting for multicaster to start")))
+                  (= multicaster-result :error)
+                  (do
+                    (log/error "Multicaster failed to start")
+                    (throw (RuntimeException. "Multicaster failed to start")))
+                  (= multicaster-result :ready)
+                  (log/debug "Multicaster is ready")
+
+                  :else
+                  (do
+                    (log/error "Unexpected state from multicaster:" multicaster-result)
+                    (throw (RuntimeException. (str "Unexpected state from multicaster: " multicaster-result)))))))
+        (let [new-q (get-in new-state [conn id])]
+          (assert (instance? BlockingQueue new-q))
+          new-q)))))
+
+(defn stop-all-multicasters! []
+  (reset! multicast-state {}))
+
+(comment
+  (do
+    (require 'com.github.ivarref.yoltq.log-init)
+    (com.github.ivarref.yoltq.log-init/init-logging!
+      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
+       [#{"com.github.ivarref.yoltq.report-queue"} :debug]
+       [#{"com.github.ivarref.yoltq.poller"} :info]
+       [#{"com.github.ivarref.yoltq"} :debug]
+       ;[#{"ivarref.yoltq*"} :info]
+       [#{"*"} :info]])
+    (defonce conn (let [uri (str "datomic:mem://demo")
+                        _ (d/delete-database uri)
+                        _ (d/create-database uri)
+                        conn (d/connect uri)]
+                    conn))))
+
+(comment
+  (defn drain! [^BlockingQueue q]
+    (loop [cnt 0]
+      (if (nil? (.poll q 1 TimeUnit/SECONDS))
+        cnt
+        (recur (inc cnt))))))
+
+(comment
+  (let [q-1 (get-tx-report-queue-multicast! conn :q1)
+        q-2 (get-tx-report-queue-multicast! conn :q2)]))
+
+(comment
+  (drain! (get-tx-report-queue-multicast! conn :q1)))
+
+(comment
+  (do
+    @(d/transact conn [{:db/doc "demo"}])
+    :yay))
\ No newline at end of file
diff --git a/test/com/github/ivarref/yoltq/log_init.clj b/test/com/github/ivarref/yoltq/log_init.clj
index 1aa6c02..f3fb6dc 100644
--- a/test/com/github/ivarref/yoltq/log_init.clj
+++ b/test/com/github/ivarref/yoltq/log_init.clj
@@ -3,6 +3,8 @@
             [taoensso.timbre :as timbre]
             [clojure.string :as str]))
 
+(set! *warn-on-reflection* true)
+
 (def level-colors
   {;:warn colors/red
    :error colors/red})
-- 
cgit v1.2.3


From 4797e559410bce644c40b05fa9a321171a781e78 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Tue, 20 May 2025 22:43:39 +0200
Subject: Improve tx-report-queue sharing #7

---
 src/com/github/ivarref/yoltq/report_queue.clj | 342 +++++++++++++++++++++-----
 test/com/github/ivarref/yoltq/log_init.clj    |   2 +-
 2 files changed, 283 insertions(+), 61 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index 9cddc93..239de12 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -6,7 +6,6 @@
   (:import (datomic Connection Datom)
            (java.util.concurrent LinkedBlockingQueue ScheduledExecutorService BlockingQueue TimeUnit)))
 
-
 (defn process-poll-result! [cfg id-ident poll-result consumer]
   (let [{:keys [tx-data db-after]} poll-result]
     (when-let [new-ids (->> tx-data
@@ -30,7 +29,6 @@
                       (catch Throwable t
                         (log/error t "Unexpected error in process-poll-result!")))))))))
 
-
 (defn report-queue-listener [running?
                              ready?
                              ^ScheduledExecutorService pool
@@ -65,80 +63,253 @@
             (log/debug "Remove tx-report-queue")
             (d/remove-tx-report-queue conn)))))))
 
-(defonce ^:private multicast-state-lock (Object.))
+; https://stackoverflow.com/a/14488425
+(defn- dissoc-in
+  "Dissociates an entry from a nested associative structure returning a new
+  nested structure. keys is a sequence of keys. Any empty maps that result
+  will not be present in the new structure."
+  [m [k & ks :as keys]]
+  (if ks
+    (if-let [nextmap (get m k)]
+      (let [newmap (dissoc-in nextmap ks)]
+        (if (seq newmap)
+          (assoc m k newmap)
+          (dissoc m k)))
+      m)
+    (dissoc m k)))
+
+(defn- queues-to-shutdown [old-state new-state]
+  (assert (map? old-state))
+  (assert (map? new-state))
+  (doseq [x (vals new-state)]
+    (assert (vector? x)))
+  (doseq [x (vals old-state)]
+    (assert (vector? x)))
+  (let [new-qs (into #{} (mapv second (vals new-state)))]
+    (reduce
+      (fn [o [send-end-token? old-q]]
+        ;(assert (boolean? send-end-token?))
+        ;(assert (instance? BlockingQueue old-q))
+        (if (contains? new-qs old-q)
+          o
+          (conj o [send-end-token? old-q])))
+      []
+      (vals old-state))))
+
+(comment
+  (queues-to-shutdown {:a [true 999] :b [false 777]}
+                      {:a [true 123] :b [true 777]}))
 
+(defn- multicast-once [conn work-item old-state new-state]
+  (assert (map? old-state))
+  (assert (map? new-state))
+  (doseq [[send-end-token? q-to-shutdown] (queues-to-shutdown old-state new-state)]
+    (if send-end-token?
+      (do
+        #_(log/debug "offering :end token")
+        (.offer ^BlockingQueue q-to-shutdown :end 1 TimeUnit/MICROSECONDS))
+      (do
+        #_(log/debug "not offering :end token"))))
+  (when (seq new-state)
+    (if (some? work-item)
+      (reduce-kv
+        (fn [m id [send-end-token? q]]
+          (let [ok-offer (.offer ^BlockingQueue q work-item 1 TimeUnit/MICROSECONDS)]
+            (if (true? ok-offer)
+              (assoc m id [send-end-token? q])
+              (log/warn "Failed to offer item in multicaster for connection" conn "and queue id" id))))
+        {}
+        new-state)
+      new-state)))
+
+(defonce ^:private multicast-state-lock (Object.))
+(defonce ^:private consumer-state-lock (Object.))
 (defonce ^:private multicast-state (atom {}))
+(defonce ^:private thread-count (atom 0))
+
+(defn- multicaster-loop [init-state conn ready?]
+  (let [input-queue (d/tx-report-queue conn)]
+    (deliver ready? true)
+    (loop [old-state init-state]
+      (let [work-item (.poll ^BlockingQueue input-queue 16 TimeUnit/MILLISECONDS)
+            new-state (locking multicast-state-lock
+                        ; writer to `multicast-state` must be protected by `multicast-state-lock`
+                        ; it should block minimally / spend minimum amount of time
+                        (swap! multicast-state (fn [old-state] (update-in old-state [:iter-count conn] (fnil inc 0))))
+                        (if-let [new-state (multicast-once conn work-item old-state (get-in @multicast-state [:queues conn] {}))]
+                          new-state
+                          (do (swap! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn])))
+                              (swap! multicast-state (fn [old-state] (update-in old-state [:thread-count conn] dec)))
+                              (d/remove-tx-report-queue conn)
+                              nil)))]
+        (if new-state
+          (recur new-state)
+          nil)))))
 
 (defn- start-multicaster! [conn]
-  (let [multicaster-ready? (promise)]
+  (let [ready? (promise)]
     (future
       (log/debug "Multicaster starting for conn" conn)
       (try
-        (let [input-queue (d/tx-report-queue conn)]
-          (loop []
-            (when-let [mcast-state (get @multicast-state conn)]
-              (when-let [dest-queues (vals mcast-state)]
-                (let [element (.poll ^BlockingQueue input-queue 1 TimeUnit/SECONDS)]
-                  (deliver multicaster-ready? :ready)
-                  (when (some? element)
-                    (doseq [q dest-queues]
-                      (let [ok-offer (.offer ^BlockingQueue q element 30 TimeUnit/MINUTES)]
-                        (when (false? ok-offer)
-                          (log/error "Failed to offer item in multicaster for connection" conn))))))
-                (recur)))))
+        (swap! thread-count inc)
+        (let [new-state (swap! multicast-state (fn [old-state] (update-in old-state [:thread-count conn] (fnil inc 0))))]
+          (assert (= 1 (get-in new-state [:thread-count conn])))
+          ; "parent" thread holds `multicast-state-lock` and
+          ; waits for `ready?` promise, so effectively this new thread also holds
+          ; the lock until `ready?` is delivered. That is: it is safe
+          ; for this thread to modify multicast-state regardless of what other threads are doing
+          (multicaster-loop (get-in new-state [:queues conn]) conn ready?))
         (catch Throwable t
-          (deliver multicaster-ready? :error)
-          (log/error t "Unexpected error in multicaster:" (.getMessage t)))
+          (log/error t "Unexpected error in multicaster:" (.getMessage t))
+          (log/error "Multicaster exiting for conn"))
         (finally
-          (d/remove-tx-report-queue conn)
+          (swap! thread-count dec)
           (log/debug "Multicaster exiting for conn" conn))))
-    multicaster-ready?))
+    @ready?))
+
+(defn- wait-multicast-thread-step [conn]
+  ; `get-tx-report-queue-multicast!` should return only when the multicaster thread
+  ; has picked up the new queue.
+  ;
+  ; Otherwise the following could happen:
+  ; 1. multicast thread is sleeping
+  ; 2: user-thread calls get-tx-report-queue-multicast! with `send-end-token?` `true`
+  ; 3: user-thread (or somebody else) calls `stop-multicaster`.
+  ; The multicast-state atom is now identical as it was in 1
+  ; 4: multicast thread is scheduled and does _not_ detect any state change.
+  ; And therefore the multicast thread does _not_ send out an :end token as one would expect.
+  ;
+  ; Once [:iter-count conn] has changed, we know that the multicaster thread
+  ; will see the new queue.
+  ; We are still holding the consumer-state-lock, so no other thread
+  ; can do any stop-multicasting that would/could corrupt the state.
+  ; We can then be sure that the queue will receive the `:end` token when/if
+  ; the queue is stopped.
+  (let [start-ms (System/currentTimeMillis)
+        iter-count (get-in @multicast-state [:iter-count conn] -1)]
+    (loop [spin-count 0]
+      (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
+        nil
+        (do
+          (let [spent-ms (- (System/currentTimeMillis) start-ms)]
+            (if (> spent-ms 30000)
+              (throw (RuntimeException. "Timed out waiting for multicaster thread"))
+              (do
+                (Thread/sleep 16)
+                (recur (inc spin-count))))))))))
 
 (defn get-tx-report-queue-multicast!
   "Multicast the datomic.api/tx-report-queue to different consumers.
   The multicaster is started on demand. `conn` and `id` identifies the consumer.
 
   Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
-  [conn id]
-  (assert (instance? Connection conn))
-  (assert (keyword? id))
-  (locking multicast-state-lock
-    (assert (map? @multicast-state))
-    (if-let [existing-q (get-in @multicast-state [conn id])]
-      (do
-        (log/debug "returning existing queue for id" id)
-        (assert (instance? BlockingQueue existing-q))
-        existing-q)
-      (let [needs-multicaster? (not (contains? @multicast-state conn))
-            new-state (swap! multicast-state (fn [old-state] (assoc-in old-state [conn id] (LinkedBlockingQueue.))))]
-        (when needs-multicaster?
-          (let [multicaster-promise (start-multicaster! conn)
-                multicaster-result (deref multicaster-promise (* 30 60000) :timeout)]
-            (cond (= multicaster-result :timeout)
-                  (do
-                    (log/error "Timeout waiting for multicaster to start")
-                    (throw (RuntimeException. "Timeout waiting for multicaster to start")))
-                  (= multicaster-result :error)
-                  (do
-                    (log/error "Multicaster failed to start")
-                    (throw (RuntimeException. "Multicaster failed to start")))
-                  (= multicaster-result :ready)
-                  (log/debug "Multicaster is ready")
+  ([conn id]
+   (get-tx-report-queue-multicast! conn id false))
+  ([conn id send-end-token?]
+   (assert (instance? Connection conn))
+   (assert (keyword? id))
+   (locking consumer-state-lock
+     (let [the-q
+           (locking multicast-state-lock
+             (assert (map? @multicast-state))
+             (if-let [existing-q (get-in @multicast-state [:queues conn id])]
+               (do
+                 (swap! multicast-state
+                        (fn [old-state]
+                          (update-in old-state [:queues conn id] (fn [[end-token? q]]
+                                                                   (if (not= end-token? send-end-token?)
+                                                                     (log/debug "flipped `send-end-token?`")
+                                                                     (log/debug "identical `send-end-token?`"))
+                                                                   [send-end-token? q]))))
+                 (log/debug "Returning existing queue for id" id)
+                 (assert (instance? BlockingQueue (second existing-q)))
+                 (second existing-q))
+               (let [needs-multicaster? (nil? (get-in @multicast-state [:queues conn]))
+                     new-q (LinkedBlockingQueue.)
+                     new-state (swap! multicast-state (fn [old-state] (assoc-in old-state [:queues conn id] [send-end-token? new-q])))]
+                 (if needs-multicaster?
+                   (do
+                     (start-multicaster! conn)
+                     (log/debug "Multicaster thread started. Returning new queue for id" id)
+                     new-q)
+                   (do
+                     (log/debug "Multicaster thread already exists. Returning new queue for id" id)
+                     new-q)))))]
+       ; wait for multicaster thread to pick up current Queue
+       (wait-multicast-thread-step conn)
+       the-q))))
 
-                  :else
+(defn wait-multicast-threads-exit [[old-state new-state]]
+  (assert (map? old-state))
+  (assert (map? new-state))
+  (assert (map? (get old-state :queues {})))
+  (assert (map? (get new-state :queues {})))
+  (assert (map? (get old-state :thread-count {})))
+  (assert (map? (get new-state :thread-count {})))
+  (locking consumer-state-lock
+    ; No new multicast threads will be launched inside this block.
+    ; The lock is already held by parent function.
+    ;
+    ; Why do we need to _wait_ for multicaster thread(s) to exit after
+    ; removing all queue ids for a given connection?
+    ; Otherwise the following could happen:
+    ; 1. multicaster thread is sleeping
+    ; 2. user calls stop-multicaster!
+    ;    One would expect that multicaster thread would exit, but it is still sleeping
+    ; 3. user calls get-tx-report-queue-multicast! with the same conn
+    ;    The state is now empty, so a new multicaster thread is spawned.
+    ; 4. Now there is two multicaster threads for the same connection!
+    ;    ... and since the datomic report queue can be shared between threads
+    ;    it will seemingly work, but when the end event is sent, it will be
+    ;    sent by multiple threads.
+    (let [old-conns (into #{} (keys (get old-state :queues {})))
+          new-conns (into #{} (keys (get new-state :queues {})))]
+      (doseq [old-conn old-conns]
+        (when-not (contains? new-conns old-conn)
+          (let [old-threadcount (get-in old-state [:thread-count old-conn] nil)]
+            (assert (= 1 old-threadcount))
+            (let [start-ms (System/currentTimeMillis)]
+              (loop []
+                (if (= 0 (get-in @multicast-state [:thread-count old-conn]))
+                  :ok
                   (do
-                    (log/error "Unexpected state from multicaster:" multicaster-result)
-                    (throw (RuntimeException. (str "Unexpected state from multicaster: " multicaster-result)))))))
-        (let [new-q (get-in new-state [conn id])]
-          (assert (instance? BlockingQueue new-q))
-          new-q)))))
+                    (let [spent-ms (- (System/currentTimeMillis) start-ms)]
+                      (if (> spent-ms 30000)
+                        (throw (RuntimeException. "Timed out waiting for multicaster thread to exit"))
+                        (do
+                          (Thread/sleep 16)
+                          (recur))))))))))))))
+
+(defn stop-multicaster-id! [conn id]
+  (locking consumer-state-lock
+    (wait-multicast-threads-exit
+      (locking multicast-state-lock
+        (swap-vals! multicast-state (fn [old-state]
+                                      (let [new-state (dissoc-in old-state [:queues conn id])]
+                                        (if (= {} (get-in new-state [:queues conn]))
+                                          (dissoc-in old-state [:queues conn])
+                                          new-state))))))))
+
+(defn stop-multicaster! [conn]
+  (locking consumer-state-lock
+    (wait-multicast-threads-exit
+      (locking multicast-state-lock
+        (swap-vals! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn])))))))
 
 (defn stop-all-multicasters! []
-  (reset! multicast-state {}))
+  (locking consumer-state-lock
+    (wait-multicast-threads-exit
+      (locking multicast-state-lock
+        (swap-vals! multicast-state (fn [old-state] (assoc old-state :queues {})))))))
 
 (comment
   (do
     (require 'com.github.ivarref.yoltq.log-init)
+    (defn drain! [^BlockingQueue q]
+      (loop [items []]
+        (if-let [elem (.poll q 100 TimeUnit/MILLISECONDS)]
+          (recur (conj items elem))
+          items)))
     (com.github.ivarref.yoltq.log-init/init-logging!
       [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
        [#{"com.github.ivarref.yoltq.report-queue"} :debug]
@@ -153,20 +324,71 @@
                     conn))))
 
 (comment
-  (defn drain! [^BlockingQueue q]
-    (loop [cnt 0]
-      (if (nil? (.poll q 1 TimeUnit/SECONDS))
-        cnt
-        (recur (inc cnt))))))
+  (do
+    (require 'com.github.ivarref.yoltq.log-init)
+    (defn drain! [^BlockingQueue q]
+      (loop [items []]
+        (if-let [elem (.poll q 100 TimeUnit/MILLISECONDS)]
+          (recur (conj items elem))
+          items)))
+    (com.github.ivarref.yoltq.log-init/init-logging!
+      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
+       [#{"com.github.ivarref.yoltq.report-queue"} :debug]
+       [#{"com.github.ivarref.yoltq.poller"} :info]
+       [#{"com.github.ivarref.yoltq"} :debug]
+       ;[#{"ivarref.yoltq*"} :info]
+       [#{"*"} :info]])
+    (log/info "********************************")
+    (defonce conn (let [uri (str "datomic:mem://demo")
+                        _ (d/delete-database uri)
+                        _ (d/create-database uri)
+                        conn (d/connect uri)]
+                    conn))
+    (log/info "stop-all!")
+    (stop-all-multicasters!)
+    (assert (= 0 @thread-count))
+    (let [q1 (get-tx-report-queue-multicast! conn :q1 false)
+          q2 (get-tx-report-queue-multicast! conn :q2 false)
+          _ (get-tx-report-queue-multicast! conn :q1 true)]
+      @(d/transact conn [{:db/doc "demo"}])
+      @(d/transact conn [{:db/doc "demo"}])
+      @(d/transact conn [{:db/doc "demo"}])
+      (log/info "begin drain q1")
+      (stop-multicaster-id! conn :q1)
+      (println "thread count" @thread-count)
+      (let [qitems-2 (drain! q2)
+            qitems-1 (drain! q1)]
+        (assert (= :end (last qitems-1)))
+        (println "drain count q1:" (count qitems-1))
+        (println "drain count q2:" (count qitems-2))))))
+
+(comment
+  (do
+    (let [q (get-tx-report-queue-multicast! conn :q1 true)]
+      (log/debug "stopping id :q1")
+      (stop-multicaster-id! conn :q1)
+      (let [drained (drain! q)]
+        (println "drained:" drained)
+        (assert (= [:end] drained)))
+      @multicast-state)))
 
 (comment
-  (let [q-1 (get-tx-report-queue-multicast! conn :q1)
-        q-2 (get-tx-report-queue-multicast! conn :q2)]))
+  (stop-all-multicasters!))
 
 (comment
-  (drain! (get-tx-report-queue-multicast! conn :q1)))
+  (do
+    (let [q (get-tx-report-queue-multicast! conn :q2 false)]
+      (println "drain count:" (count (drain! q)))
+      @multicast-state
+      nil)))
+
+(comment
+  (get-tx-report-queue-multicast! conn :q1 false)
+  (get-tx-report-queue-multicast! conn :q1 true))
 
 (comment
   (do
+    @(d/transact conn [{:db/doc "demo"}])
+    @(d/transact conn [{:db/doc "demo"}])
     @(d/transact conn [{:db/doc "demo"}])
     :yay))
\ No newline at end of file
diff --git a/test/com/github/ivarref/yoltq/log_init.clj b/test/com/github/ivarref/yoltq/log_init.clj
index f3fb6dc..7eae557 100644
--- a/test/com/github/ivarref/yoltq/log_init.clj
+++ b/test/com/github/ivarref/yoltq/log_init.clj
@@ -48,7 +48,7 @@
 
                   (color-f (force msg_))
 
-                  #_maybe-stacktrace))))
+                  maybe-stacktrace))))
 
 
     (catch Throwable t
-- 
cgit v1.2.3


From aa0b3d0bd9e087c7e1e36e87cd6e10f9e2796449 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Wed, 21 May 2025 09:51:30 +0200
Subject: Doc rationale for waiting for multicaster thread. Handle :end token
 in report-queue-listener  #7

---
 src/com/github/ivarref/yoltq/report_queue.clj | 91 +++++++++++++++------------
 1 file changed, 51 insertions(+), 40 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index 239de12..2a2e489 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -45,15 +45,20 @@
     (assert (instance? BlockingQueue q))
     (log/debug "tx-report-queue-given:" tx-report-queue-given)
     (try
-      (while @running?
-        (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
-          (process-poll-result! @config-atom
-                                id-ident
-                                poll-result
-                                (fn [f]
-                                  (when @running?
-                                    (.execute ^ScheduledExecutorService pool f)))))
-        (deliver ready? :ready))
+      (let [running-local? (atom true)]
+        (while (and @running? @running-local?)
+          (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
+            (if (= poll-result :end)
+              (do
+                (reset! running-local? false)
+                #_(log/warn "yoltq report-queue-listener received :end token. If the rest of the system is kept running, it will result in a partially broken system."))
+              (process-poll-result! @config-atom
+                                    id-ident
+                                    poll-result
+                                    (fn [f]
+                                      (when @running?
+                                        (.execute ^ScheduledExecutorService pool f))))))
+          (deliver ready? :ready)))
       (catch Throwable t
         (log/error t "Unexpected error in report-queue-listener:" (.getMessage t)))
       (finally
@@ -128,6 +133,7 @@
 (defonce ^:private thread-count (atom 0))
 
 (defn- multicaster-loop [init-state conn ready?]
+  (assert (instance? Connection conn))
   (let [input-queue (d/tx-report-queue conn)]
     (deliver ready? true)
     (loop [old-state init-state]
@@ -147,6 +153,7 @@
           nil)))))
 
 (defn- start-multicaster! [conn]
+  (assert (instance? Connection conn))
   (let [ready? (promise)]
     (future
       (log/debug "Multicaster starting for conn" conn)
@@ -165,38 +172,42 @@
         (finally
           (swap! thread-count dec)
           (log/debug "Multicaster exiting for conn" conn))))
-    @ready?))
+    (when (= :timeout (deref ready? 30000 :timeout))
+      (throw (RuntimeException. "Timed out waiting for multicaster to start")))))
 
-(defn- wait-multicast-thread-step [conn]
-  ; `get-tx-report-queue-multicast!` should return only when the multicaster thread
-  ; has picked up the new queue.
-  ;
-  ; Otherwise the following could happen:
-  ; 1. multicast thread is sleeping
-  ; 2: user-thread calls get-tx-report-queue-multicast! with `send-end-token?` `true`
-  ; 3: user-thread (or somebody else) calls `stop-multicaster`.
-  ; The multicast-state atom is now identical as it was in 1
-  ; 4: multicast thread is scheduled and does _not_ detect any state change.
-  ; And therefore the multicast thread does _not_ send out an :end token as one would expect.
-  ;
-  ; Once [:iter-count conn] has changed, we know that the multicaster thread
-  ; will see the new queue.
-  ; We are still holding the consumer-state-lock, so no other thread
-  ; can do any stop-multicasting that would/could corrupt the state.
-  ; We can then be sure that the queue will receive the `:end` token when/if
-  ; the queue is stopped.
-  (let [start-ms (System/currentTimeMillis)
-        iter-count (get-in @multicast-state [:iter-count conn] -1)]
-    (loop [spin-count 0]
-      (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
-        nil
-        (do
-          (let [spent-ms (- (System/currentTimeMillis) start-ms)]
-            (if (> spent-ms 30000)
-              (throw (RuntimeException. "Timed out waiting for multicaster thread"))
-              (do
-                (Thread/sleep 16)
-                (recur (inc spin-count))))))))))
+(defn- wait-multicast-thread-step [conn])
+; `get-tx-report-queue-multicast!` should return only when the multicaster thread
+; has picked up the new queue.
+;
+; Otherwise the following could happen:
+; 1. multicast thread is sleeping
+; 2: user-thread calls get-tx-report-queue-multicast! with `send-end-token?` `true`
+; 3: user-thread (or somebody else) calls `stop-multicaster`.
+;    The multicast-state atom is now identical as it was in step 1.
+; ,  Step 2 and 3 happened while the multicast thread was sleeping.
+; 4: The multicast thread is scheduled and does _not_ detect any state change.
+;    Therefore the multicast thread does _not_ send out an :end token as one would expect.
+;
+; The new queue is written to memory at this point. No other thread can remove it because
+; we are still, and have been during the modification of multicast-state, holding consumer-state-lock.
+; This means that the multicast thread cannot exit at this point. Also, because we hold the consumer-state-lock,
+; we can be sure that no other thread changes or has changed the state.
+;
+; Once [:iter-count conn] has changed, we know that the multicaster thread
+; will see the new queue. This means that we can be sure that the queue
+; will receive the `:end` token if the queue is stopped.
+(let [start-ms (System/currentTimeMillis)
+      iter-count (get-in @multicast-state [:iter-count conn] -1)]
+  (loop [spin-count 0]
+    (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
+      nil
+      (do
+        (let [spent-ms (- (System/currentTimeMillis) start-ms)]
+          (if (> spent-ms 30000)
+            (throw (RuntimeException. "Timed out waiting for multicaster thread"))
+            (do
+              (Thread/sleep 16)
+              (recur (inc spin-count)))))))))
 
 (defn get-tx-report-queue-multicast!
   "Multicast the datomic.api/tx-report-queue to different consumers.
-- 
cgit v1.2.3


From ccfe353aebe8c22429fdaf76a5e0bf34cefca955 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Wed, 21 May 2025 12:04:15 +0200
Subject: Small fixes  #7

---
 src/com/github/ivarref/yoltq.clj              | 51 ++++++++++++++--
 src/com/github/ivarref/yoltq/report_queue.clj | 86 +++++++++++++--------------
 2 files changed, 88 insertions(+), 49 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 32298b7..80c9491 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -352,8 +352,8 @@
              :p95 ...
              :p99 ...}}"
   [{:keys [age-days queue-name now db duration->long]
-    :or   {age-days 30
-           now      (ZonedDateTime/now ZoneOffset/UTC)
+    :or   {age-days       30
+           now            (ZonedDateTime/now ZoneOffset/UTC)
            duration->long (fn [duration] (.toSeconds ^Duration duration))}}]
   (let [{:keys [conn]} @*config*
         db (or db (d/db conn))
@@ -386,11 +386,50 @@
 
 (defn get-tx-report-queue-multicast!
   "Multicast the datomic.api/tx-report-queue to different consumers.
-  The multicaster is started on demand. `conn` and `id` identifies the consumer.
+   A multicaster thread is started on demand per connection. `conn` and `id` identifies the consumer.
+   Repeated calls using the same `conn` and `id` returns the same queue.
+
+   The optional third parameter, `send-end-token?`, if set to `true`, instructs the multicaster thread
+   to send `:end` if the queue is stopped. The default value is `false`.
+
+   A queue may be stopped using `stop-multicaster-id!`, `stop-multicaster!` or `stop-all-multicasters!`.
+
+   Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
+  ([conn id]
+   (get-tx-report-queue-multicast! conn id false))
+  ([conn id send-end-token?]
+   (assert (instance? Connection conn))
+   (assert (boolean? send-end-token?))
+   (rq/get-tx-report-queue-multicast! conn id send-end-token?)))
+
+(defn stop-multicaster-id!
+  "Stop forwarding reports from datomic.api/tx-report-queue to the queue identified by `conn` and `id`.
+  If this is the last report destination for the given `conn`, the multicaster thread will exit.
+  Repeated calls are no-op.
 
-  Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
+  Returns nil."
   [conn id]
-  (rq/get-tx-report-queue-multicast! conn id))
+  (assert (instance? Connection conn))
+  (rq/stop-multicaster-id! conn id))
+
+(defn stop-multicaster!
+  "Stop forwarding reports from datomic.api/tx-report-queue to any queues belonging to `conn`.
+  The multicaster thread will exit.
+  Repeated calls are no-op.
+
+  Returns nil."
+  [conn]
+  (assert (instance? Connection conn))
+  (rq/stop-multicaster! conn))
+
+(defn stop-all-multicasters!
+  "Stop forwarding all reports from datomic.api/tx-report-queue for any `conn`.
+  All multicaster threads will exit.
+  Repeated calls are no-op.
+
+  Returns nil."
+  []
+  (rq/stop-all-multicasters!))
 
 (comment
   (do
@@ -446,7 +485,7 @@
             started-consuming? (promise)
             n 1]
         (init! {:conn                         conn
-                :tx-report-queue (get-tx-report-queue-multicast! conn :yoltq)
+                :tx-report-queue              (get-tx-report-queue-multicast! conn :yoltq)
                 :slow-thread-show-stacktrace? false})
         (add-consumer! :q (fn [_]
                             (deliver started-consuming? true)))
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index 2a2e489..a9f7e07 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -6,6 +6,8 @@
   (:import (datomic Connection Datom)
            (java.util.concurrent LinkedBlockingQueue ScheduledExecutorService BlockingQueue TimeUnit)))
 
+; Private API, subject to change!
+
 (defn process-poll-result! [cfg id-ident poll-result consumer]
   (let [{:keys [tx-data db-after]} poll-result]
     (when-let [new-ids (->> tx-data
@@ -50,8 +52,9 @@
           (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
             (if (= poll-result :end)
               (do
-                (reset! running-local? false)
-                #_(log/warn "yoltq report-queue-listener received :end token. If the rest of the system is kept running, it will result in a partially broken system."))
+                (log/debug "Report queue listener received :end token. Exiting")
+                (reset! running-local? false))
+                ;(log/warn "yoltq report-queue-listener received :end token. If the rest of the system is kept running, it will result in a partially broken system."))
               (process-poll-result! @config-atom
                                     id-ident
                                     poll-result
@@ -175,7 +178,8 @@
     (when (= :timeout (deref ready? 30000 :timeout))
       (throw (RuntimeException. "Timed out waiting for multicaster to start")))))
 
-(defn- wait-multicast-thread-step [conn])
+(defn- wait-multicast-thread-step
+  [conn]
 ; `get-tx-report-queue-multicast!` should return only when the multicaster thread
 ; has picked up the new queue.
 ;
@@ -196,29 +200,34 @@
 ; Once [:iter-count conn] has changed, we know that the multicaster thread
 ; will see the new queue. This means that we can be sure that the queue
 ; will receive the `:end` token if the queue is stopped.
-(let [start-ms (System/currentTimeMillis)
-      iter-count (get-in @multicast-state [:iter-count conn] -1)]
-  (loop [spin-count 0]
-    (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
-      nil
-      (do
-        (let [spent-ms (- (System/currentTimeMillis) start-ms)]
-          (if (> spent-ms 30000)
-            (throw (RuntimeException. "Timed out waiting for multicaster thread"))
-            (do
-              (Thread/sleep 16)
-              (recur (inc spin-count)))))))))
+  (let [start-ms (System/currentTimeMillis)
+        iter-count (get-in @multicast-state [:iter-count conn] -1)]
+    (loop [spin-count 0]
+      (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
+        nil
+        (do
+          (let [spent-ms (- (System/currentTimeMillis) start-ms)]
+            (if (> spent-ms 30000)
+              (throw (RuntimeException. "Timed out waiting for multicaster thread"))
+              (do
+                (Thread/sleep 16)
+                (recur (inc spin-count))))))))))
 
 (defn get-tx-report-queue-multicast!
   "Multicast the datomic.api/tx-report-queue to different consumers.
-  The multicaster is started on demand. `conn` and `id` identifies the consumer.
+   A multicaster thread is started on demand per connection. `conn` and `id` identifies the consumer.
+   Repeated calls using the same `conn` and `id` returns the same queue.
+
+   The optional third parameter, `send-end-token?`, if set to `true`, instructs the multicaster thread
+   to send `:end` if the queue is stopped. The default value is `false`.
 
-  Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
+   A queue may be stopped using `stop-multicaster-id!`, `stop-multicaster!` or `stop-all-multicasters!`.
+
+   Returns a `java.util.concurrent.BlockingQueue` like `datomic.api/tx-report-queue`."
   ([conn id]
    (get-tx-report-queue-multicast! conn id false))
   ([conn id send-end-token?]
    (assert (instance? Connection conn))
-   (assert (keyword? id))
    (locking consumer-state-lock
      (let [the-q
            (locking multicast-state-lock
@@ -250,7 +259,7 @@
        (wait-multicast-thread-step conn)
        the-q))))
 
-(defn wait-multicast-threads-exit [[old-state new-state]]
+(defn- wait-multicast-threads-exit [[old-state new-state]]
   (assert (map? old-state))
   (assert (map? new-state))
   (assert (map? (get old-state :queues {})))
@@ -275,6 +284,12 @@
     ;    sent by multiple threads.
     (let [old-conns (into #{} (keys (get old-state :queues {})))
           new-conns (into #{} (keys (get new-state :queues {})))]
+      (assert (every?
+                (fn [x] (instance? Connection x))
+                old-conns))
+      (assert (every?
+                (fn [x] (instance? Connection x))
+                new-conns))
       (doseq [old-conn old-conns]
         (when-not (contains? new-conns old-conn)
           (let [old-threadcount (get-in old-state [:thread-count old-conn] nil)]
@@ -292,6 +307,7 @@
                           (recur))))))))))))))
 
 (defn stop-multicaster-id! [conn id]
+  (assert (instance? Connection conn))
   (locking consumer-state-lock
     (wait-multicast-threads-exit
       (locking multicast-state-lock
@@ -299,40 +315,23 @@
                                       (let [new-state (dissoc-in old-state [:queues conn id])]
                                         (if (= {} (get-in new-state [:queues conn]))
                                           (dissoc-in old-state [:queues conn])
-                                          new-state))))))))
+                                          new-state)))))))
+  nil)
 
 (defn stop-multicaster! [conn]
+  (assert (instance? Connection conn))
   (locking consumer-state-lock
     (wait-multicast-threads-exit
       (locking multicast-state-lock
-        (swap-vals! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn])))))))
+        (swap-vals! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn]))))))
+  nil)
 
 (defn stop-all-multicasters! []
   (locking consumer-state-lock
     (wait-multicast-threads-exit
       (locking multicast-state-lock
-        (swap-vals! multicast-state (fn [old-state] (assoc old-state :queues {})))))))
-
-(comment
-  (do
-    (require 'com.github.ivarref.yoltq.log-init)
-    (defn drain! [^BlockingQueue q]
-      (loop [items []]
-        (if-let [elem (.poll q 100 TimeUnit/MILLISECONDS)]
-          (recur (conj items elem))
-          items)))
-    (com.github.ivarref.yoltq.log-init/init-logging!
-      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
-       [#{"com.github.ivarref.yoltq.report-queue"} :debug]
-       [#{"com.github.ivarref.yoltq.poller"} :info]
-       [#{"com.github.ivarref.yoltq"} :debug]
-       ;[#{"ivarref.yoltq*"} :info]
-       [#{"*"} :info]])
-    (defonce conn (let [uri (str "datomic:mem://demo")
-                        _ (d/delete-database uri)
-                        _ (d/create-database uri)
-                        conn (d/connect uri)]
-                    conn))))
+        (swap-vals! multicast-state (fn [old-state] (assoc old-state :queues {}))))))
+  nil)
 
 (comment
   (do
@@ -366,6 +365,7 @@
       @(d/transact conn [{:db/doc "demo"}])
       (log/info "begin drain q1")
       (stop-multicaster-id! conn :q1)
+      (stop-multicaster-id! conn :q1)
       (println "thread count" @thread-count)
       (let [qitems-2 (drain! q2)
             qitems-1 (drain! q1)]
-- 
cgit v1.2.3


From a1e4e1b96fd254ec7d7e467648dd5e88f1c9530b Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Wed, 21 May 2025 13:38:51 +0200
Subject: Doc. Return true/false if queues were stopped or not  #7

---
 README.md                                     |  37 ++++++-
 deps.edn                                      |  12 +++
 src/com/github/ivarref/yoltq.clj              |  23 +++-
 src/com/github/ivarref/yoltq/report_queue.clj | 146 ++++++++++++++++++--------
 4 files changed, 163 insertions(+), 55 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index f84a336..675fa9a 100644
--- a/README.md
+++ b/README.md
@@ -441,21 +441,48 @@ then not grab the datomic report queue, but use the one provided:
 ```clojure
 (require '[com.github.ivarref.yoltq :as yq])
 (yq/init! {:conn            conn
-           :tx-report-queue (yq/get-tx-report-queue-multicast! my-conn :yoltq)
+           :tx-report-queue (yq/get-tx-report-queue-multicast! conn :yoltq)
                             ; ^^ can be any `java.util.concurrent.BlockingQueue` value
                             })
 
-(another-tx-report-consumer! (yq/get-tx-report-queue-multicast! my-conn :another-consumer-id))
+(another-tx-report-consumer! (yq/get-tx-report-queue-multicast! conn :another-consumer-id))
 
 ```
 
 Added multicast support for `datomic.api/tx-report-queue`:
 ```clojure
-(def my-q1 (yq/get-tx-report-queue-multicast! my-conn :q-id-1))
+(require '[com.github.ivarref.yoltq :as yq])
+(def my-q1 (yq/get-tx-report-queue-multicast! conn :q-id-1))
 ; ^^ consume my-q1 just like you would do `datomic.api/tx-report-queue`
 
-(def my-q2 (yq/get-tx-report-queue-multicast! my-conn :q-id-2))
-; Both my-q1 and my-q2 will receive everything from `datomic.api/tx-report-queue`
+(def my-q2 (yq/get-tx-report-queue-multicast! conn :q-id-2))
+; Both my-q1 and my-q2 will receive everything from `datomic.api/tx-report-queue` for the given `conn`
+
+(def my-q3 (yq/get-tx-report-queue-multicast! conn :q-id-3 true))
+; my-q3 specifies the third argument, `send-end-token?`, to true, so it will receive `:end` if the queue is stopped.
+; This can enable simpler consuming of queues:
+(future
+  (loop []
+    (let [q-item (.take ^java.util.concurrent.BlockingQueue my-q3)]
+      (if (= q-item :end)
+        (println "Time to exit. Goodbye!")
+        (do
+          (println "Processing q-item" q-item)
+          (recur))))))
+
+@(d/transact conn [{:db/doc "new-data"}])
+
+; Stop the queue:
+(yq/stop-multicaster-id! conn :q-id-3)
+=> true
+; The multicaster thread will send `:end` and the consumer thread will then print "Time to exit. Goodbye!".
+
+; if the queue is already stopped (or never was started), `stop-multicaster...` functions will return false:
+(yq/stop-multicaster-id! conn :already-stopped-queue-or-typo)
+=> false
+
+; Stop all queues for all connections:
+(yq/stop-all-multicasters!)
 ```
 
 `yq/get-tx-report-queue-multicast!` returns, like
diff --git a/deps.edn b/deps.edn
index 1e3fa9d..a328c86 100644
--- a/deps.edn
+++ b/deps.edn
@@ -22,6 +22,18 @@
                                                    :sha     "0e8731e0f24db05b74769e219051b0e92b50624a"}}
                      :main-opts  ["-m" "mach.pack.alpha.skinny" "--no-libs" "--project-path" "target/out.jar"]}
 
+           :repl    {:extra-paths ["test"]
+                     :extra-deps  {com.bhauman/rebel-readline              {:mvn/version "0.1.5"}
+                                   ivarref/datomic-schema                  {:mvn/version "0.2.0"}
+                                   com.taoensso/timbre                     {:mvn/version "5.2.1"}
+                                   com.fzakaria/slf4j-timbre               {:mvn/version "0.3.21"}
+                                   clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"}
+                                   org.postgresql/postgresql               {:mvn/version "9.3-1102-jdbc41"}
+                                   com.taoensso/nippy                      {:mvn/version "3.2.0"}}
+                     :exec-fn     rebel-readline.tool/repl
+                     :exec-args   {}
+                     :main-opts   ["-m" "rebel-readline.main"]}
+
            :release {:extra-deps {ivarref/pom-patch {:mvn/version "0.1.16"}}}
 
            :deploy  {:extra-deps {slipset/deps-deploy {:mvn/version "0.2.0"}}
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 80c9491..298b9d5 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -407,7 +407,11 @@
   If this is the last report destination for the given `conn`, the multicaster thread will exit.
   Repeated calls are no-op.
 
-  Returns nil."
+  The multicaster thread will send `:end` if `send-end-token?` was `true` when `get-tx-report-queue-multicast!`
+  was called.
+
+  Returns `true` if the queue was stopped.
+  Return `false` if the queue does not exist."
   [conn id]
   (assert (instance? Connection conn))
   (rq/stop-multicaster-id! conn id))
@@ -417,7 +421,11 @@
   The multicaster thread will exit.
   Repeated calls are no-op.
 
-  Returns nil."
+  The multicaster thread will send `:end` if `send-end-token?` was `true` when `get-tx-report-queue-multicast!`
+  was called.
+
+  Returns `true` if any queue belonging to `conn` was stopped.
+  Returns `false` is `conn` did not have any associated queues."
   [conn]
   (assert (instance? Connection conn))
   (rq/stop-multicaster! conn))
@@ -427,7 +435,11 @@
   All multicaster threads will exit.
   Repeated calls are no-op.
 
-  Returns nil."
+  The multicaster thread will send `:end` if `send-end-token?` was `true` when `get-tx-report-queue-multicast!`
+  was called.
+
+  Returns `true` if any queue was stopped.
+  Returns `false` if no queues existed."
   []
   (rq/stop-all-multicasters!))
 
@@ -485,7 +497,7 @@
             started-consuming? (promise)
             n 1]
         (init! {:conn                         conn
-                :tx-report-queue              (get-tx-report-queue-multicast! conn :yoltq)
+                :tx-report-queue              (get-tx-report-queue-multicast! conn :yoltq true)
                 :slow-thread-show-stacktrace? false})
         (add-consumer! :q (fn [_]
                             (deliver started-consuming? true)))
@@ -493,8 +505,11 @@
         (start!)
         (log/info "begin start! ... Done")
         (Thread/sleep 2000)
+        (log/info "*******************************************")
         @(d/transact conn [(put :q {:work 123})])
         @started-consuming?
+        (stop-multicaster! conn)
+        (log/info "*******************************************")
         (stop!)
         (log/info "stop! done")
         nil))))
\ No newline at end of file
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index a9f7e07..c3fd383 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -52,9 +52,9 @@
           (when-let [poll-result (.poll ^BlockingQueue q 1 TimeUnit/SECONDS)]
             (if (= poll-result :end)
               (do
-                (log/debug "Report queue listener received :end token. Exiting")
+                (log/debug "report-queue-listener received :end token. Exiting")
                 (reset! running-local? false))
-                ;(log/warn "yoltq report-queue-listener received :end token. If the rest of the system is kept running, it will result in a partially broken system."))
+              ;(log/warn "yoltq report-queue-listener received :end token. If the rest of the system is kept running, it will result in a partially broken system."))
               (process-poll-result! @config-atom
                                     id-ident
                                     poll-result
@@ -115,9 +115,11 @@
     (if send-end-token?
       (do
         #_(log/debug "offering :end token")
-        (.offer ^BlockingQueue q-to-shutdown :end 1 TimeUnit/MICROSECONDS))
+        (if (.offer ^BlockingQueue q-to-shutdown :end 1 TimeUnit/MICROSECONDS)
+          (log/debug "Multicaster sent :end token")
+          (log/debug "Multicaster failed to send :end token")))
       (do
-        #_(log/debug "not offering :end token"))))
+        (log/debug "Multicaster not sending :end token"))))
   (when (seq new-state)
     (if (some? work-item)
       (reduce-kv
@@ -125,7 +127,7 @@
           (let [ok-offer (.offer ^BlockingQueue q work-item 1 TimeUnit/MICROSECONDS)]
             (if (true? ok-offer)
               (assoc m id [send-end-token? q])
-              (log/warn "Failed to offer item in multicaster for connection" conn "and queue id" id))))
+              (log/error "Multicaster failed to offer item for connection" conn "and queue id" id))))
         {}
         new-state)
       new-state)))
@@ -150,6 +152,7 @@
                           (do (swap! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn])))
                               (swap! multicast-state (fn [old-state] (update-in old-state [:thread-count conn] dec)))
                               (d/remove-tx-report-queue conn)
+                              (log/debug "Multicaster removed tx-report-queue for conn" conn)
                               nil)))]
         (if new-state
           (recur new-state)
@@ -180,26 +183,26 @@
 
 (defn- wait-multicast-thread-step
   [conn]
-; `get-tx-report-queue-multicast!` should return only when the multicaster thread
-; has picked up the new queue.
-;
-; Otherwise the following could happen:
-; 1. multicast thread is sleeping
-; 2: user-thread calls get-tx-report-queue-multicast! with `send-end-token?` `true`
-; 3: user-thread (or somebody else) calls `stop-multicaster`.
-;    The multicast-state atom is now identical as it was in step 1.
-; ,  Step 2 and 3 happened while the multicast thread was sleeping.
-; 4: The multicast thread is scheduled and does _not_ detect any state change.
-;    Therefore the multicast thread does _not_ send out an :end token as one would expect.
-;
-; The new queue is written to memory at this point. No other thread can remove it because
-; we are still, and have been during the modification of multicast-state, holding consumer-state-lock.
-; This means that the multicast thread cannot exit at this point. Also, because we hold the consumer-state-lock,
-; we can be sure that no other thread changes or has changed the state.
-;
-; Once [:iter-count conn] has changed, we know that the multicaster thread
-; will see the new queue. This means that we can be sure that the queue
-; will receive the `:end` token if the queue is stopped.
+  ; `get-tx-report-queue-multicast!` should return only when the multicaster thread
+  ; has picked up the new queue.
+  ;
+  ; Otherwise the following could happen:
+  ; 1. multicast thread is sleeping
+  ; 2: user-thread calls get-tx-report-queue-multicast! with `send-end-token?` `true`
+  ; 3: user-thread (or somebody else) calls `stop-multicaster`.
+  ;    The multicast-state atom is now identical as it was in step 1.
+  ; ,  Step 2 and 3 happened while the multicast thread was sleeping.
+  ; 4: The multicast thread is scheduled and does _not_ detect any state change.
+  ;    Therefore the multicast thread does _not_ send out an :end token as one would expect.
+  ;
+  ; The new queue is written to memory at this point. No other thread can remove it because
+  ; we are still, and have been during the modification of multicast-state, holding consumer-state-lock.
+  ; This means that the multicast thread cannot exit at this point. Also, because we hold the consumer-state-lock,
+  ; we can be sure that no other thread changes or has changed the state.
+  ;
+  ; Once [:iter-count conn] has changed, we know that the multicaster thread
+  ; will see the new queue. This means that we can be sure that the queue
+  ; will receive the `:end` token if the queue is stopped.
   (let [start-ms (System/currentTimeMillis)
         iter-count (get-in @multicast-state [:iter-count conn] -1)]
     (loop [spin-count 0]
@@ -250,10 +253,10 @@
                  (if needs-multicaster?
                    (do
                      (start-multicaster! conn)
-                     (log/debug "Multicaster thread started. Returning new queue for id" id)
+                     (log/debug "Returning new queue for id" id "(multicaster thread started)")
                      new-q)
                    (do
-                     (log/debug "Multicaster thread already exists. Returning new queue for id" id)
+                     (log/debug "Returning new queue for id" id "(multicaster thread already running)")
                      new-q)))))]
        ; wait for multicaster thread to pick up current Queue
        (wait-multicast-thread-step conn)
@@ -306,32 +309,83 @@
                           (Thread/sleep 16)
                           (recur))))))))))))))
 
+(defn- all-queues [state]
+  (->> (mapcat (fn [[conn qmap]]
+                 (mapv (fn [q-id] [conn q-id])
+                       (keys qmap)))
+               (seq (get state :queues {})))
+       (into #{})))
+
+(comment
+  (do
+    (assert (= #{}
+               (all-queues {})))
+    (assert (= #{}
+               (all-queues {:queues {}})))
+    (assert (= #{[:conn-a :q-id]}
+               (all-queues {:queues {:conn-a {:q-id 1}}})))
+    (assert (= #{[:conn-a :q-id] [:conn-a :q-id-2]}
+               (all-queues {:queues {:conn-a {:q-id 1 :q-id-2 2}}})))
+    (assert (= #{[:conn-a :q-id-2] [:conn-b :q-id-3] [:conn-a :q-id]}
+               (all-queues {:queues {:conn-a {:q-id 1 :q-id-2 2}
+                                     :conn-b {:q-id-3 3}}})))))
+
+(defn- removed-queues? [old new]
+  (not= (all-queues old)
+        (all-queues new)))
+
 (defn stop-multicaster-id! [conn id]
   (assert (instance? Connection conn))
-  (locking consumer-state-lock
-    (wait-multicast-threads-exit
-      (locking multicast-state-lock
-        (swap-vals! multicast-state (fn [old-state]
-                                      (let [new-state (dissoc-in old-state [:queues conn id])]
-                                        (if (= {} (get-in new-state [:queues conn]))
-                                          (dissoc-in old-state [:queues conn])
-                                          new-state)))))))
-  nil)
+  (let [did-remove? (atom nil)]
+    (locking consumer-state-lock
+      (wait-multicast-threads-exit
+        (locking multicast-state-lock
+          (let [[old new] (swap-vals! multicast-state (fn [old-state]
+                                                        (let [new-state (dissoc-in old-state [:queues conn id])]
+                                                          (if (= {} (get-in new-state [:queues conn]))
+                                                            (dissoc-in old-state [:queues conn])
+                                                            new-state))))]
+              (reset! did-remove? (removed-queues? old new))
+            [old new]))))
+    @did-remove?))
 
 (defn stop-multicaster! [conn]
   (assert (instance? Connection conn))
-  (locking consumer-state-lock
-    (wait-multicast-threads-exit
-      (locking multicast-state-lock
-        (swap-vals! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn]))))))
-  nil)
+  (let [did-remove? (atom nil)]
+    (locking consumer-state-lock
+      (wait-multicast-threads-exit
+        (locking multicast-state-lock
+          (let [[old new] (swap-vals! multicast-state (fn [old-state] (dissoc-in old-state [:queues conn])))]
+            (reset! did-remove? (removed-queues? old new))
+            [old new]))))
+    @did-remove?))
 
 (defn stop-all-multicasters! []
-  (locking consumer-state-lock
-    (wait-multicast-threads-exit
-      (locking multicast-state-lock
-        (swap-vals! multicast-state (fn [old-state] (assoc old-state :queues {}))))))
-  nil)
+  (let [did-remove? (atom nil)]
+    (locking consumer-state-lock
+      (wait-multicast-threads-exit
+        (locking multicast-state-lock
+          (let [[old new] (swap-vals! multicast-state (fn [old-state] (assoc old-state :queues {})))]
+            (reset! did-remove? (removed-queues? old new))
+            [old new]))))
+    @did-remove?))
+
+(comment
+  (do
+    (require 'com.github.ivarref.yoltq.log-init)
+    (require '[datomic.api :as d])
+    (com.github.ivarref.yoltq.log-init/init-logging!
+      [[#{"datomic.*" "com.datomic.*" "org.apache.*"} :warn]
+       [#{"com.github.ivarref.yoltq.report-queue"} :debug]
+       [#{"com.github.ivarref.yoltq.poller"} :info]
+       [#{"com.github.ivarref.yoltq"} :debug]
+       ;[#{"ivarref.yoltq*"} :info]
+       [#{"*"} :info]])
+    (defonce conn (let [uri (str "datomic:mem://demo")
+                        _ (d/delete-database uri)
+                        _ (d/create-database uri)
+                        conn (d/connect uri)]
+                    conn))))
 
 (comment
   (do
-- 
cgit v1.2.3


From 4a3a9a5da6e7a8771eb3adb79172aca5ce8f26a6 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Wed, 21 May 2025 13:48:10 +0200
Subject: Misc #7

---
 README.md                                     | 4 ++--
 src/com/github/ivarref/yoltq.clj              | 4 ++--
 src/com/github/ivarref/yoltq/report_queue.clj | 2 +-
 3 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 675fa9a..dda9b47 100644
--- a/README.md
+++ b/README.md
@@ -473,12 +473,12 @@ Added multicast support for `datomic.api/tx-report-queue`:
 @(d/transact conn [{:db/doc "new-data"}])
 
 ; Stop the queue:
-(yq/stop-multicaster-id! conn :q-id-3)
+(yq/stop-multicast-consumer-id! conn :q-id-3)
 => true
 ; The multicaster thread will send `:end` and the consumer thread will then print "Time to exit. Goodbye!".
 
 ; if the queue is already stopped (or never was started), `stop-multicaster...` functions will return false:
-(yq/stop-multicaster-id! conn :already-stopped-queue-or-typo)
+(yq/stop-multicast-consumer-id! conn :already-stopped-queue-or-typo)
 => false
 
 ; Stop all queues for all connections:
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 298b9d5..45f2051 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -402,7 +402,7 @@
    (assert (boolean? send-end-token?))
    (rq/get-tx-report-queue-multicast! conn id send-end-token?)))
 
-(defn stop-multicaster-id!
+(defn stop-multicast-consumer-id!
   "Stop forwarding reports from datomic.api/tx-report-queue to the queue identified by `conn` and `id`.
   If this is the last report destination for the given `conn`, the multicaster thread will exit.
   Repeated calls are no-op.
@@ -414,7 +414,7 @@
   Return `false` if the queue does not exist."
   [conn id]
   (assert (instance? Connection conn))
-  (rq/stop-multicaster-id! conn id))
+  (rq/stop-multicast-consumer-id! conn id))
 
 (defn stop-multicaster!
   "Stop forwarding reports from datomic.api/tx-report-queue to any queues belonging to `conn`.
diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index c3fd383..b3685b9 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -334,7 +334,7 @@
   (not= (all-queues old)
         (all-queues new)))
 
-(defn stop-multicaster-id! [conn id]
+(defn stop-multicast-consumer-id! [conn id]
   (assert (instance? Connection conn))
   (let [did-remove? (atom nil)]
     (locking consumer-state-lock
-- 
cgit v1.2.3


From 22ca1bb29111f9a0246c54e7f81806794198c25f Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Wed, 21 May 2025 13:59:55 +0200
Subject: Doc #7

---
 README.md                        | 3 +++
 src/com/github/ivarref/yoltq.clj | 3 ++-
 2 files changed, 5 insertions(+), 1 deletion(-)

(limited to 'src/com/github/ivarref')

diff --git a/README.md b/README.md
index 836ed49..0635d5f 100644
--- a/README.md
+++ b/README.md
@@ -471,6 +471,9 @@ Added multicast support for `datomic.api/tx-report-queue`:
           (println "Processing q-item" q-item)
           (recur))))))
 
+; The default value for `send-end-token?` is `false`, i.e. the behaviour will be
+; identical to that of datomic.api/tx-report-queue.
+
 @(d/transact conn [{:db/doc "new-data"}])
 
 ; Stop the queue:
diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 45f2051..0f63e25 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -390,7 +390,8 @@
    Repeated calls using the same `conn` and `id` returns the same queue.
 
    The optional third parameter, `send-end-token?`, if set to `true`, instructs the multicaster thread
-   to send `:end` if the queue is stopped. The default value is `false`.
+   to send `:end` if the queue is stopped.
+   The default value for `send-end-token?` is `false`.
 
    A queue may be stopped using `stop-multicaster-id!`, `stop-multicaster!` or `stop-all-multicasters!`.
 
-- 
cgit v1.2.3


From 28cd44d2bc25dbb3651d33bc80efe4173e0479f5 Mon Sep 17 00:00:00 2001
From: ire <refsdal.ivar@gmail.com>
Date: Mon, 26 May 2025 12:58:34 +0200
Subject: Be paranoid #7

---
 src/com/github/ivarref/yoltq/report_queue.clj | 54 +++++++++++++--------------
 1 file changed, 27 insertions(+), 27 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq/report_queue.clj b/src/com/github/ivarref/yoltq/report_queue.clj
index b3685b9..f83e3ba 100644
--- a/src/com/github/ivarref/yoltq/report_queue.clj
+++ b/src/com/github/ivarref/yoltq/report_queue.clj
@@ -182,7 +182,7 @@
       (throw (RuntimeException. "Timed out waiting for multicaster to start")))))
 
 (defn- wait-multicast-thread-step
-  [conn]
+  [conn state]
   ; `get-tx-report-queue-multicast!` should return only when the multicaster thread
   ; has picked up the new queue.
   ;
@@ -201,20 +201,20 @@
   ; we can be sure that no other thread changes or has changed the state.
   ;
   ; Once [:iter-count conn] has changed, we know that the multicaster thread
-  ; will see the new queue. This means that we can be sure that the queue
+  ; has seen the new queue. This means that we can be sure that the queue
   ; will receive the `:end` token if the queue is stopped.
   (let [start-ms (System/currentTimeMillis)
-        iter-count (get-in @multicast-state [:iter-count conn] -1)]
+        iter-count (get-in state [:iter-count conn] -1)]
     (loop [spin-count 0]
-      (if (not= iter-count (get-in @multicast-state [:iter-count conn]))
+      (if (not= iter-count (locking multicast-state-lock
+                             (get-in @multicast-state [:iter-count conn] -1)))
         nil
-        (do
-          (let [spent-ms (- (System/currentTimeMillis) start-ms)]
-            (if (> spent-ms 30000)
-              (throw (RuntimeException. "Timed out waiting for multicaster thread"))
-              (do
-                (Thread/sleep 16)
-                (recur (inc spin-count))))))))))
+        (let [spent-ms (- (System/currentTimeMillis) start-ms)]
+          (if (> spent-ms 30000)
+            (throw (RuntimeException. "Timed out waiting for multicaster thread"))
+            (do
+              (Thread/sleep 16)
+              (recur (inc spin-count)))))))))
 
 (defn get-tx-report-queue-multicast!
   "Multicast the datomic.api/tx-report-queue to different consumers.
@@ -232,21 +232,21 @@
   ([conn id send-end-token?]
    (assert (instance? Connection conn))
    (locking consumer-state-lock
-     (let [the-q
+     (let [[new-state the-q]
            (locking multicast-state-lock
              (assert (map? @multicast-state))
              (if-let [existing-q (get-in @multicast-state [:queues conn id])]
                (do
-                 (swap! multicast-state
-                        (fn [old-state]
-                          (update-in old-state [:queues conn id] (fn [[end-token? q]]
-                                                                   (if (not= end-token? send-end-token?)
-                                                                     (log/debug "flipped `send-end-token?`")
-                                                                     (log/debug "identical `send-end-token?`"))
-                                                                   [send-end-token? q]))))
-                 (log/debug "Returning existing queue for id" id)
-                 (assert (instance? BlockingQueue (second existing-q)))
-                 (second existing-q))
+                 (let [new-state (swap! multicast-state
+                                        (fn [old-state]
+                                          (update-in old-state [:queues conn id] (fn [[end-token? q]]
+                                                                                   (if (not= end-token? send-end-token?)
+                                                                                     (log/debug "flipped `send-end-token?`")
+                                                                                     (log/debug "identical `send-end-token?`"))
+                                                                                   [send-end-token? q]))))]
+                   (log/debug "Returning existing queue for id" id)
+                   (assert (instance? BlockingQueue (second existing-q)))
+                   [new-state (second existing-q)]))
                (let [needs-multicaster? (nil? (get-in @multicast-state [:queues conn]))
                      new-q (LinkedBlockingQueue.)
                      new-state (swap! multicast-state (fn [old-state] (assoc-in old-state [:queues conn id] [send-end-token? new-q])))]
@@ -254,12 +254,12 @@
                    (do
                      (start-multicaster! conn)
                      (log/debug "Returning new queue for id" id "(multicaster thread started)")
-                     new-q)
+                     [new-state new-q])
                    (do
                      (log/debug "Returning new queue for id" id "(multicaster thread already running)")
-                     new-q)))))]
+                     [new-state new-q])))))]
        ; wait for multicaster thread to pick up current Queue
-       (wait-multicast-thread-step conn)
+       (wait-multicast-thread-step conn new-state)
        the-q))))
 
 (defn- wait-multicast-threads-exit [[old-state new-state]]
@@ -418,8 +418,8 @@
       @(d/transact conn [{:db/doc "demo"}])
       @(d/transact conn [{:db/doc "demo"}])
       (log/info "begin drain q1")
-      (stop-multicaster-id! conn :q1)
-      (stop-multicaster-id! conn :q1)
+      (stop-multicast-consumer-id! conn :q1)
+      (stop-multicast-consumer-id! conn :q1)
       (println "thread count" @thread-count)
       (let [qitems-2 (drain! q2)
             qitems-1 (drain! q1)]
-- 
cgit v1.2.3


From 8b46092126baea5cd73465f5d544cdb0f75547b6 Mon Sep 17 00:00:00 2001
From: Stefan van den Oord <stefan@viduet.eu>
Date: Tue, 16 Sep 2025 10:36:07 +0200
Subject: Rename batch -> job-group

---
 src/com/github/ivarref/yoltq.clj               | 14 +++++++-------
 src/com/github/ivarref/yoltq/impl.clj          |  6 +++---
 test/com/github/ivarref/yoltq/virtual_test.clj | 16 ++++++++--------
 3 files changed, 18 insertions(+), 18 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index ccd9062..88a7c31 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -257,27 +257,27 @@
          (sort-by (juxt :qname :status))
          (vec))))
 
-(defn batch-progress [queue-name batch-name]
+(defn job-group-progress [queue-name job-group-name]
   (let [{:keys [conn]} @*config*
         db (d/db conn)]
-    (->> (d/q '[:find ?e ?qname ?bname ?status
+    (->> (d/q '[:find ?e ?qname ?jgname ?status
                 :keys :e :qname :bname :status
-                :in $ ?qname ?bname
+                :in $ ?qname ?jgname
                 :where
                 [?e :com.github.ivarref.yoltq/queue-name ?qname]
-                [?e :com.github.ivarref.yoltq/batch-name ?bname]
+                [?e :com.github.ivarref.yoltq/job-group-name ?jgname]
                 [?e :com.github.ivarref.yoltq/status ?status]]
-              db queue-name batch-name)
+              db queue-name job-group-name)
          (mapv #(select-keys % [:qname :bname :status]))
          (mapv (fn [qitem] {qitem 1}))
          (reduce (partial merge-with +) {})
          (mapv (fn [[{:keys [qname bname status]} v]]
                  (array-map
                   :qname qname
-                  :batch-name bname
+                  :job-group-name bname
                   :status status
                   :count v)))
-         (sort-by (juxt :qname :batch-name :status))
+         (sort-by (juxt :qname :job-group-name :status))
          (vec))))
 
 (defn get-errors [qname]
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index 6d2aa3d..e77655b 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -12,7 +12,7 @@
   [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
    #:db{:ident :com.github.ivarref.yoltq/ext-id, :cardinality :db.cardinality/one, :valueType :db.type/string, :unique :db.unique/value}
    #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
-   #:db{:ident :com.github.ivarref.yoltq/batch-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
+   #:db{:ident :com.github.ivarref.yoltq/job-group-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/payload-bytes, :cardinality :db.cardinality/one, :valueType :db.type/bytes}
@@ -105,8 +105,8 @@
               (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
           (when-let [ext-id (:id opts)]
             {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})
-          (when-let [batch-name (:batch-name opts)]
-            {:com.github.ivarref.yoltq/batch-name batch-name}))))
+          (when-let [job-group-name (:job-group-name opts)]
+            {:com.github.ivarref.yoltq/job-group-name job-group-name}))))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index 7621b13..d245aaa 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -451,24 +451,24 @@
     (tq/consume! :q)
     (is (= @got-work "asdf"))))
 
-(deftest batch-of-jobs-test
+(deftest job-group-test
   (let [conn (u/empty-conn)]
     (yq/init! {:conn conn})
     (yq/add-consumer! :q1 identity)
     (yq/add-consumer! :q2 identity)
-    @(d/transact conn [(yq/put :q1 {:work 123} {:batch-name :b1})
-                       (yq/put :q1 {:work 456} {:batch-name :b2})
-                       (yq/put :q2 {:work 789} {:batch-name :b1})])
+    @(d/transact conn [(yq/put :q1 {:work 123} {:job-group-name :b1})
+                       (yq/put :q1 {:work 456} {:job-group-name :b2})
+                       (yq/put :q2 {:work 789} {:job-group-name :b1})])
     (is (= [{:qname :q1
-             :batch-name :b1
+             :job-group-name :b1
              :status :init
              :count 1}]
-           (yq/batch-progress :q1 :b1)))
+           (yq/job-group-progress :q1 :b1)))
 
     (is (= {:work 123} (tq/consume! :q1)))
 
     (is (= [{:qname :q1
-             :batch-name :b1
+             :job-group-name :b1
              :status :done
              :count 1}]
-           (yq/batch-progress :q1 :b1)))))
+           (yq/job-group-progress :q1 :b1)))))
-- 
cgit v1.2.3


From 698ab89d3a48fd6c42f0abbb1fb6b6c9e8d4d53a Mon Sep 17 00:00:00 2001
From: Stefan van den Oord <stefan@viduet.eu>
Date: Tue, 16 Sep 2025 11:10:02 +0200
Subject: Improve naming: job-group is a keyword, so don't include "-name"

---
 src/com/github/ivarref/yoltq.clj               | 20 ++++++++++----------
 src/com/github/ivarref/yoltq/impl.clj          |  6 +++---
 test/com/github/ivarref/yoltq/virtual_test.clj | 14 +++++++-------
 3 files changed, 20 insertions(+), 20 deletions(-)

(limited to 'src/com/github/ivarref')

diff --git a/src/com/github/ivarref/yoltq.clj b/src/com/github/ivarref/yoltq.clj
index 88a7c31..8c8ca7a 100644
--- a/src/com/github/ivarref/yoltq.clj
+++ b/src/com/github/ivarref/yoltq.clj
@@ -257,27 +257,27 @@
          (sort-by (juxt :qname :status))
          (vec))))
 
-(defn job-group-progress [queue-name job-group-name]
+(defn job-group-progress [queue-name job-group]
   (let [{:keys [conn]} @*config*
         db (d/db conn)]
-    (->> (d/q '[:find ?e ?qname ?jgname ?status
-                :keys :e :qname :bname :status
-                :in $ ?qname ?jgname
+    (->> (d/q '[:find ?e ?qname ?job-group ?status
+                :keys :e :qname :job-group :status
+                :in $ ?qname ?job-group
                 :where
                 [?e :com.github.ivarref.yoltq/queue-name ?qname]
-                [?e :com.github.ivarref.yoltq/job-group-name ?jgname]
+                [?e :com.github.ivarref.yoltq/job-group ?job-group]
                 [?e :com.github.ivarref.yoltq/status ?status]]
-              db queue-name job-group-name)
-         (mapv #(select-keys % [:qname :bname :status]))
+              db queue-name job-group)
+         (mapv #(select-keys % [:qname :job-group :status]))
          (mapv (fn [qitem] {qitem 1}))
          (reduce (partial merge-with +) {})
-         (mapv (fn [[{:keys [qname bname status]} v]]
+         (mapv (fn [[{:keys [qname job-group status]} v]]
                  (array-map
                   :qname qname
-                  :job-group-name bname
+                  :job-group job-group
                   :status status
                   :count v)))
-         (sort-by (juxt :qname :job-group-name :status))
+         (sort-by (juxt :qname :job-group :status))
          (vec))))
 
 (defn get-errors [qname]
diff --git a/src/com/github/ivarref/yoltq/impl.clj b/src/com/github/ivarref/yoltq/impl.clj
index e77655b..ffb1ad8 100644
--- a/src/com/github/ivarref/yoltq/impl.clj
+++ b/src/com/github/ivarref/yoltq/impl.clj
@@ -12,7 +12,7 @@
   [#:db{:ident :com.github.ivarref.yoltq/id, :cardinality :db.cardinality/one, :valueType :db.type/uuid, :unique :db.unique/identity}
    #:db{:ident :com.github.ivarref.yoltq/ext-id, :cardinality :db.cardinality/one, :valueType :db.type/string, :unique :db.unique/value}
    #:db{:ident :com.github.ivarref.yoltq/queue-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
-   #:db{:ident :com.github.ivarref.yoltq/job-group-name, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
+   #:db{:ident :com.github.ivarref.yoltq/job-group, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/status, :cardinality :db.cardinality/one, :valueType :db.type/keyword, :index true}
    #:db{:ident :com.github.ivarref.yoltq/payload, :cardinality :db.cardinality/one, :valueType :db.type/string}
    #:db{:ident :com.github.ivarref.yoltq/payload-bytes, :cardinality :db.cardinality/one, :valueType :db.type/bytes}
@@ -105,8 +105,8 @@
               (throw (ex-info (str ":depends-on not found in database. Queue: " q ", id: " ext-id) opts))))
           (when-let [ext-id (:id opts)]
             {:com.github.ivarref.yoltq/ext-id (pr-str-safe :id [queue-name ext-id])})
-          (when-let [job-group-name (:job-group-name opts)]
-            {:com.github.ivarref.yoltq/job-group-name job-group-name}))))
+          (when-let [job-group (:job-group opts)]
+            {:com.github.ivarref.yoltq/job-group job-group}))))
     (do
       (log/error "Did not find registered handler for queue" queue-name)
       (throw (ex-info (str "Did not find registered handler for queue: " queue-name) {:queue queue-name})))))
diff --git a/test/com/github/ivarref/yoltq/virtual_test.clj b/test/com/github/ivarref/yoltq/virtual_test.clj
index d245aaa..a2ed269 100644
--- a/test/com/github/ivarref/yoltq/virtual_test.clj
+++ b/test/com/github/ivarref/yoltq/virtual_test.clj
@@ -456,19 +456,19 @@
     (yq/init! {:conn conn})
     (yq/add-consumer! :q1 identity)
     (yq/add-consumer! :q2 identity)
-    @(d/transact conn [(yq/put :q1 {:work 123} {:job-group-name :b1})
-                       (yq/put :q1 {:work 456} {:job-group-name :b2})
-                       (yq/put :q2 {:work 789} {:job-group-name :b1})])
+    @(d/transact conn [(yq/put :q1 {:work 123} {:job-group :group1})
+                       (yq/put :q1 {:work 456} {:job-group :group2})
+                       (yq/put :q2 {:work 789} {:job-group :group1})])
     (is (= [{:qname :q1
-             :job-group-name :b1
+             :job-group :group1
              :status :init
              :count 1}]
-           (yq/job-group-progress :q1 :b1)))
+           (yq/job-group-progress :q1 :group1)))
 
     (is (= {:work 123} (tq/consume! :q1)))
 
     (is (= [{:qname :q1
-             :job-group-name :b1
+             :job-group :group1
              :status :done
              :count 1}]
-           (yq/job-group-progress :q1 :b1)))))
+           (yq/job-group-progress :q1 :group1)))))
-- 
cgit v1.2.3