fix: create-exception-middleware for deep hierarchies

The code was not finding the closest ancestor to the error type,
because `ancestors` is not ordered. Now the code does a DFS to find a
nearest ancestor. If the nearest ancestor is non-unique, an arbitrary
one is picked.
This commit is contained in:
Joel Kaasinen 2026-01-09 09:26:21 +02:00
parent 2c87d90bda
commit 75faf709e2
No known key found for this signature in database
2 changed files with 57 additions and 5 deletions

View file

@ -19,17 +19,17 @@
(recur (.getSuperclass sk) (conj ks sk))
ks)))
(defn- ancestors-safe [type]
(when-not (class? type) (ancestors type)))
(defn- find-closest-ancestor [val m]
(or (get m val)
(some #(find-closest-ancestor % m) (parents val))))
(defn- call-error-handler [handlers error request]
(let [type (:type (ex-data error))
ex-class (class error)
error-handler (or (get handlers type)
(get handlers ex-class)
(some
(partial get handlers)
(ancestors-safe type))
(when-not (class? type)
(find-closest-ancestor type handlers))
(some
(partial get handlers)
(super-classes ex-class))
@ -143,6 +143,9 @@
4) Super Classes of exception
5) The ::default handler
Note! If the closest ancestor for `:type` is not unique, an
arbitrary one is picked.
Example:
(require '[reitit.ring.middleware.exception :as exception])

View file

@ -147,6 +147,55 @@
(is (= status 500))
(is (= body "too many tries")))))))
(derive ::table ::object)
(derive ::living ::object)
(derive ::plant ::living)
(derive ::animal ::living)
(derive ::dog ::animal)
(derive ::cat ::animal)
(derive ::garfield ::cat)
(deftest exception-hierarchy-test
(letfn [(create [f]
(ring/ring-handler
(ring/router
[["/defaults"
{:handler f}]]
{:data {:middleware [(exception/create-exception-middleware
(merge
exception/default-handlers
{::object (constantly (http-response/bad-request "object"))
::living (constantly (http-response/bad-request "living"))
::animal (constantly (http-response/bad-request "animal"))
::cat (constantly (http-response/bad-request "cat"))}))]}})))
(call [ex-typ]
(let [app (create (fn [_] (throw (ex-info "fail" {:type ex-typ}))))]
(app {:request-method :get, :uri "/defaults"})))]
(let [{:keys [status body]} (call ::object)]
(is (= status 400))
(is (= body "object")))
(let [{:keys [status body]} (call ::table)]
(is (= status 400))
(is (= body "object")))
(let [{:keys [status body]} (call ::living)]
(is (= status 400))
(is (= body "living")))
(let [{:keys [status body]} (call ::plant)]
(is (= status 400))
(is (= body "living")))
(let [{:keys [status body]} (call ::animal)]
(is (= status 400))
(is (= body "animal")))
(let [{:keys [status body]} (call ::dog)]
(is (= status 400))
(is (= body "animal")))
(let [{:keys [status body]} (call ::cat)]
(is (= status 400))
(is (= body "cat")))
(let [{:keys [status body]} (call ::garfield)]
(is (= status 400))
(is (= body "cat")))))
(deftest spec-coercion-exception-test
(let [app (ring/ring-handler
(ring/router