[new] [#184] Incl. cause on non-native freeze failures

Before this commit:

  - When freezing an item WITHOUT a native Nippy implementation,
    Nippy may try to use (1) Java Serializable or (2) Clojure's reader.
    If these also fail, an ex-info will be thrown.
    The ex-info does NOT include any info about possible exceptions
    from (1) or (2).

After this commit:

  - The thrown ex-info now includes info about possible exceptions
    from (1) and (2). These can be useful, e.g. when indicating
    an OOM error, etc.
This commit is contained in:
Peter Taoussanis 2025-04-14 16:25:33 +02:00
parent 1026ea0ae7
commit 8d107650cd
2 changed files with 49 additions and 54 deletions

View file

@ -894,51 +894,45 @@
(-run! (fn [in] (-freeze-with-meta! in out)) s))))) (-run! (fn [in] (-freeze-with-meta! in out)) s)))))
(defn- write-serializable [^DataOutput out x ^String class-name] (defn- write-serializable [^DataOutput out x]
(when-debug (println (str "write-serializable: " (type x)))) (when-debug (println (str "write-serializable: " (type x))))
(let [class-name-ba (.getBytes class-name StandardCharsets/UTF_8) (when (and (instance? Serializable x) (not (fn? x)))
len (alength class-name-ba)] (let [class-name (.getName (class x))] ; Reflect
(when (freeze-serializable-allowed? class-name)
(let [class-name-ba (.getBytes class-name StandardCharsets/UTF_8)
len (alength class-name-ba)]
(enc/cond (enc/cond
(sm-count? len) (do (write-id out id-sz-quarantined-sm) (write-bytes-sm out class-name-ba)) (sm-count? len) (do (write-id out id-sz-quarantined-sm) (write-bytes-sm out class-name-ba))
(md-count? len) (do (write-id out id-sz-quarantined-md) (write-bytes-md out class-name-ba)) (md-count? len) (do (write-id out id-sz-quarantined-md) (write-bytes-md out class-name-ba))
;; :else (do (write-id out id-sz-quarantined-lg) (write-bytes-md out class-name-ba)) ; Unrealistic ;; :else (do (write-id out id-sz-quarantined-lg) (write-bytes-md out class-name-ba)) ; Unrealistic
:else (throw (ex-info "Serializable class name too long" {:name class-name}))) :else (throw (ex-info "Serializable class name too long" {:name class-name})))
;; Legacy: write object directly to out. ;; Legacy: write object directly to out.
;; (.writeObject (ObjectOutputStream. out) x) ;; (.writeObject (ObjectOutputStream. out) x)
;; Quarantined: write object to ba, then ba to out. ;; Quarantined: write object to ba, then ba to out.
;; We'll have object length during thaw, allowing us to skip readObject. ;; We'll have object length during thaw, allowing us to skip readObject.
(let [quarantined-ba (ByteArrayOutputStream.)] (let [quarantined-ba (ByteArrayOutputStream.)]
(.writeObject (ObjectOutputStream. (DataOutputStream. quarantined-ba)) x) (.writeObject (ObjectOutputStream. (DataOutputStream. quarantined-ba)) x)
(write-bytes out (.toByteArray quarantined-ba))))) (write-bytes out (.toByteArray quarantined-ba)))
true)))))
(defn- write-readable [^DataOutput out x] (defn- write-readable [^DataOutput out x]
(when-debug (println (str "write-readable: " (type x)))) (when-debug (println (str "write-readable: " (type x))))
(let [edn (enc/pr-edn x)
edn-ba (.getBytes ^String edn StandardCharsets/UTF_8)
len (alength edn-ba)]
(enc/cond
(sm-count? len) (do (write-id out id-reader-sm) (write-bytes-sm out edn-ba))
(md-count? len) (do (write-id out id-reader-md) (write-bytes-md out edn-ba))
:else (do (write-id out id-reader-lg) (write-bytes-lg out edn-ba)))))
(defn try-write-serializable [out x]
(when (and (instance? Serializable x) (not (fn? x)))
(try
(let [class-name (.getName (class x))] ; Reflect
(when (freeze-serializable-allowed? class-name)
(write-serializable out x class-name)
true))
(catch Throwable _ nil))))
(defn try-write-readable [out x]
(when (impl/seems-readable? x) (when (impl/seems-readable? x)
(try (let [edn (enc/pr-edn x)
(write-readable out x) edn-ba (.getBytes ^String edn StandardCharsets/UTF_8)
true len (alength edn-ba)]
(catch Throwable _ nil)))) (enc/cond
(sm-count? len) (do (write-id out id-reader-sm) (write-bytes-sm out edn-ba))
(md-count? len) (do (write-id out id-reader-md) (write-bytes-md out edn-ba))
:else (do (write-id out id-reader-lg) (write-bytes-lg out edn-ba)))
true)))
(defn ^:deprecated try-write-serializable [out x] (enc/catching (write-serializable out x)))
(defn ^:deprecated try-write-readable [out x] (enc/catching (write-readable out x)))
(defn- try-pr-edn [x] (defn- try-pr-edn [x]
(try (try
@ -956,13 +950,6 @@
:content (try-pr-edn x)}} :content (try-pr-edn x)}}
out)) out))
(defn throw-unfreezable [x]
(let [t (type x)]
(throw
(ex-info (str "Unfreezable type: " t)
{:type t
:as-str (try-pr-edn x)}))))
;; Public `-freeze-with-meta!` with different arg order ;; Public `-freeze-with-meta!` with different arg order
(defn freeze-to-out! (defn freeze-to-out!
"Serializes arg (any Clojure data type) to a DataOutput. "Serializes arg (any Clojure data type) to a DataOutput.
@ -1197,13 +1184,21 @@
(write-unfreezable out x))) (write-unfreezable out x)))
;; Without ff ;; Without ff
(or (enc/cond
(try-write-serializable out x) :let [[r1 e1] (try [(write-serializable out x)] (catch Throwable t [nil t]))], r1 r1
(try-write-readable out x) :let [[r2 e2] (try [(write-readable out x)] (catch Throwable t [nil t]))], r2 r2
(when-let [fff *final-freeze-fallback*] (fff out x) true) ; Deprecated :if-let [fff *final-freeze-fallback*] (fff out x) ; Deprecated
:else
(throw-unfreezable x))))) (let [t (type x)]
(throw
(ex-info (str "Failed to freeze type: " t)
(enc/assoc-some
{:type t
:as-str (try-pr-edn x)}
{:serializable-error e1
:readable-error e2})
(or e1 e2))))))))
;;;; ;;;;

View file

@ -94,12 +94,12 @@
(let [n range-uint+] (= (thaw (freeze n)) n)) (let [n range-uint+] (= (thaw (freeze n)) n))
(let [n (- range-uint+)] (= (thaw (freeze n)) n))])) (let [n (- range-uint+)] (= (thaw (freeze n)) n))]))
(is (enc/throws? :ex-info "Unfreezable type" (nippy/freeze (fn [])))) (is (enc/throws? :ex-info "Failed to freeze type" (nippy/freeze (fn []))))
(testing "Clojure v1.10+ metadata protocol extensions" (testing "Clojure v1.10+ metadata protocol extensions"
[(is (enc/throws? :ex-info "Unfreezable type" (nippy/freeze (with-meta [] {:a :A, 'b (fn [])})))) [(is (enc/throws? :ex-info "Failed to freeze type" (nippy/freeze (with-meta [] {:a :A, 'b (fn [])}))))
(is (= {:a :A} (meta (nippy/thaw (nippy/freeze (with-meta [] {:a :A, 'b/c (fn [])})))))) (is (= {:a :A} (meta (nippy/thaw (nippy/freeze (with-meta [] {:a :A, 'b/c (fn [])}))))))
(is (= nil (meta (nippy/thaw (nippy/freeze (with-meta [] { 'b/c (fn [])}))))) (is (= nil (meta (nippy/thaw (nippy/freeze (with-meta [] { 'b/c (fn [])})))))
"Don't attach empty metadata")]) "Don't attach empty metadata")])
(is (gen-test 1600 [gen-data] (= gen-data (thaw (freeze gen-data)))) "Generative")]) (is (gen-test 1600 [gen-data] (= gen-data (thaw (freeze gen-data)))) "Generative")])