luciano/nippy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[nop] Misc housekeeping

Browse source
This commit is contained in:
Peter Taoussanis 2022-07-19 09:19:37 +02:00
parent 129ce952bc
commit 621f1189c7
6 changed files with 152 additions and 308 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

407
src/taoensso/nippy.clj
View file

@ -24,9 +24,7 @@
PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList
LazySeq IRecord ISeq IType])) LazySeq IRecord ISeq IType]))
(if (vector? enc/encore-version) (enc/assert-min-encore-version [3 58 0])
(enc/assert-min-encore-version [3 23 0])
(enc/assert-min-encore-version 3.23))
(comment (comment
(set! *unchecked-math* :warn-on-boxed) (set! *unchecked-math* :warn-on-boxed)
@ -131,11 +129,9 @@
106 [:kw-sm [[:bytes {:read 1}]]] 106 [:kw-sm [[:bytes {:read 1}]]]
85 [:kw-md [[:bytes {:read 2}]]] 85 [:kw-md [[:bytes {:read 2}]]]
14 [:kw-lg [[:bytes {:read 4}]]] ; Unrealistic, removal candidate?
56 [:sym-sm [[:bytes {:read 1}]]] 56 [:sym-sm [[:bytes {:read 1}]]]
86 [:sym-md [[:bytes {:read 2}]]] 86 [:sym-md [[:bytes {:read 2}]]]
57 [:sym-lg [[:bytes {:read 4}]]] ; Unrealistic, removal candidate?
47 [:reader-sm [[:bytes {:read 1}]]] 47 [:reader-sm [[:bytes {:read 1}]]]
51 [:reader-md [[:bytes {:read 2}]]] 51 [:reader-md [[:bytes {:read 2}]]]
@ -196,7 +192,6 @@
48 [:record-sm [[:bytes {:read 1}] [:elements 1]]] 48 [:record-sm [[:bytes {:read 1}] [:elements 1]]]
49 [:record-md [[:bytes {:read 2}] [:elements 1]]] 49 [:record-md [[:bytes {:read 2}] [:elements 1]]]
80 [:record-lg [[:bytes {:read 4}] [:elements 1]]] ; Unrealistic, removal candidate?
;; Necessarily without size information ;; Necessarily without size information
81 [:type nil] 81 [:type nil]
@ -222,6 +217,10 @@
50 [:sz-unquarantined-md_ nil] ; [2020-07-24 v2.15.0] Unskippable, Ref. #130 50 [:sz-unquarantined-md_ nil] ; [2020-07-24 v2.15.0] Unskippable, Ref. #130
46 [:sz-unquarantined-sm_ nil] ; [2020-07-24 v2.15.0] Unskippable, Ref. #130 46 [:sz-unquarantined-sm_ nil] ; [2020-07-24 v2.15.0] Unskippable, Ref. #130
14 [:kw-lg_ [[:bytes {:read 4}]]] ; [2020-09-20 v3.0.0] Unrealistic
57 [:sym-lg_ [[:bytes {:read 4}]]] ; [2020-09-20 v3.0.0] Unrealistic
80 [:record-lg_ [[:bytes {:read 4}] [:elements 1]]] ; [2020-09-20 v3.0.0] Unrealistic
5 [:reader-lg_ [[:bytes {:read 4}]]] ; [2016-07-24 v2.12.0] Identical to :reader-lg, historical accident 5 [:reader-lg_ [[:bytes {:read 4}]]] ; [2016-07-24 v2.12.0] Identical to :reader-lg, historical accident
4 [:boolean_ [[:bytes 1]]] ; [2016-07-24 v2.12.0] For switch to true/false ids 4 [:boolean_ [[:bytes 1]]] ; [2016-07-24 v2.12.0] For switch to true/false ids
@ -310,28 +309,29 @@
;;;; Ns imports (for convenience of lib consumers) ;;;; Ns imports (for convenience of lib consumers)
(do (enc/defaliases
(enc/defalias compress compression/compress) compression/compress
(enc/defalias decompress compression/decompress) compression/decompress
(enc/defalias snappy-compressor compression/snappy-compressor) compression/snappy-compressor
(enc/defalias lzma2-compressor compression/lzma2-compressor) compression/lzma2-compressor
(enc/defalias lz4-compressor compression/lz4-compressor) compression/lz4-compressor
(enc/defalias lz4hc-compressor compression/lz4hc-compressor) compression/lz4hc-compressor
(enc/defalias encrypt encryption/encrypt) encryption/encrypt
(enc/defalias decrypt encryption/decrypt) encryption/decrypt
(enc/defalias aes128-gcm-encryptor encryption/aes128-gcm-encryptor) encryption/aes128-gcm-encryptor
(enc/defalias aes128-cbc-encryptor encryption/aes128-cbc-encryptor) encryption/aes128-cbc-encryptor
(enc/defalias aes128-encryptor encryption/aes128-gcm-encryptor) ; Default encryption/aes128-gcm-encryptor
{:src encryption/aes128-gcm-encryptor, :alias aes128-encryptor}
(enc/defalias freezable? utils/freezable?)) utils/freezable?)
;;;; Dynamic config ;;;; Dynamic config
;; See also `nippy.tools` ns for further dynamic config support ;; See also `nippy.tools` ns for further dynamic config support
;; For back compatibility (nb Timbre's Carmine appender) ;; For back compatibility (nb Timbre's Carmine appender)
(enc/defonce ^:dynamic *final-freeze-fallback* "DEPRECATED: prefer `*freeze-fallback`." nil) (enc/defonce ^:dynamic ^:deprecated *final-freeze-fallback* "DEPRECATED: prefer `*freeze-fallback`." nil)
(enc/defonce ^:dynamic *freeze-fallback* "(fn [data-output x])->freeze, nil => default" nil) (enc/defonce ^:dynamic *freeze-fallback* "(fn [data-output x])->freeze, nil => default" nil)
(enc/defonce ^:dynamic *custom-readers* "{<hash-or-byte-id> (fn [data-input])->read}" nil) (enc/defonce ^:dynamic *custom-readers* "{<hash-or-byte-id> (fn [data-input])->read}" nil)
@ -408,18 +408,20 @@
(defn- init-allowlist [action default incl-legacy?] (defn- init-allowlist [action default incl-legacy?]
(let [allowlist-base (let [allowlist-base
(or (or
(when-let [s (or (when-let [s
(enc/get-sys-val (get-in ids [action :base :prop]) (get-in ids [action :base :env])) (or
(when incl-legacy? (do (enc/get-sys-val (get-in ids [action :base :prop]) (get-in ids [action :base :env])))
(enc/get-sys-val (get-in ids [:legacy :base :prop]) (get-in ids [:legacy :base :env]))))] (when incl-legacy? (enc/get-sys-val (get-in ids [:legacy :base :prop]) (get-in ids [:legacy :base :env]))))]
(if (allow-and-record? s) s (split-class-names>set s))) (if (allow-and-record? s) s (split-class-names>set s)))
default) default)
allowlist-add allowlist-add
(when-let [s (or (when-let [s
(enc/get-sys-val (get-in ids [action :add :prop]) (get-in ids [action :add :env])) (or
(when incl-legacy? (do (enc/get-sys-val (get-in ids [action :add :prop]) (get-in ids [action :add :env])))
(enc/get-sys-val (get-in ids [:legacy :add :prop]) (get-in ids [:legacy :add :env]))))] (when incl-legacy? (enc/get-sys-val (get-in ids [:legacy :add :prop]) (get-in ids [:legacy :add :env]))))]
(if (allow-and-record? s) s (split-class-names>set s)))] (if (allow-and-record? s) s (split-class-names>set s)))]
(if (and allowlist-base allowlist-add) (if (and allowlist-base allowlist-add)
@ -496,7 +498,7 @@
(enc/defonce ^{:dynamic true :doc doc} *freeze-serializable-allowlist* (init-allowlist :freeze default-freeze-serializable-allowlist false)) (enc/defonce ^{:dynamic true :doc doc} *freeze-serializable-allowlist* (init-allowlist :freeze default-freeze-serializable-allowlist false))
(enc/defonce ^{:dynamic true :doc doc} *thaw-serializable-allowlist* (init-allowlist :thaw default-thaw-serializable-allowlist true))) (enc/defonce ^{:dynamic true :doc doc} *thaw-serializable-allowlist* (init-allowlist :thaw default-thaw-serializable-allowlist true)))
(enc/defonce ^:dynamic *serializable-whitelist* (enc/defonce ^:dynamic ^:deprecated *serializable-whitelist*
;; Mostly retained for https://github.com/juxt/crux/releases/tag/20.09-1.11.0 ;; Mostly retained for https://github.com/juxt/crux/releases/tag/20.09-1.11.0
"DEPRECATED, now called `*thaw-serializable-allowlist*`" nil) "DEPRECATED, now called `*thaw-serializable-allowlist*`" nil)
@ -610,8 +612,8 @@
(do (do
(defmacro write-id [out id] `(.writeByte ~out ~id)) (defmacro write-id [out id] `(.writeByte ~out ~id))
(defmacro ^:private sm-count? [n] `(<= ~n 127)) (defmacro ^:private sm-count? [n] `(<= ~n Byte/MAX_VALUE))
(defmacro ^:private md-count? [n] `(<= ~n 32767)) (defmacro ^:private md-count? [n] `(<= ~n Short/MAX_VALUE))
(defmacro ^:private write-sm-count [out n] `(.writeByte ~out ~n)) (defmacro ^:private write-sm-count [out n] `(.writeByte ~out ~n))
(defmacro ^:private write-md-count [out n] `(.writeShort ~out ~n)) (defmacro ^:private write-md-count [out n] `(.writeShort ~out ~n))
@ -636,40 +638,18 @@
nil (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output)) nil (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output))
Object (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output))) Object (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output)))
(defn- write-bytes-sm [^DataOutput out ^bytes ba] (defn- write-bytes-sm [^DataOutput out ^bytes ba] (let [len (alength ba)] (write-sm-count out len) (.write out ba 0 len)))
(let [len (alength ba)] (defn- write-bytes-md [^DataOutput out ^bytes ba] (let [len (alength ba)] (write-md-count out len) (.write out ba 0 len)))
;; (byte len) (defn- write-bytes-lg [^DataOutput out ^bytes ba] (let [len (alength ba)] (write-lg-count out len) (.write out ba 0 len)))
(write-sm-count out len)
(.write out ba 0 len)))
(defn- write-bytes-md [^DataOutput out ^bytes ba]
(let [len (alength ba)]
;; (short len)
(write-md-count out len)
(.write out ba 0 len)))
(defn- write-bytes-lg [^DataOutput out ^bytes ba]
(let [len (alength ba)]
(write-lg-count out len)
(.write out ba 0 len)))
(defn- write-bytes [^DataOutput out ^bytes ba] (defn- write-bytes [^DataOutput out ^bytes ba]
(let [len (alength ba)] (let [len (alength ba)]
(if (zero? len) (if (zero? len)
(write-id out id-bytes-0) (write-id out id-bytes-0)
(do (do
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-bytes-sm) (write-sm-count out len))
(do (write-id out id-bytes-sm) (md-count? len) (do (write-id out id-bytes-md) (write-md-count out len))
(write-sm-count out len)) :else (do (write-id out id-bytes-lg) (write-lg-count out len)))
(md-count? len)
(do (write-id out id-bytes-md)
(write-md-count out len))
:else
(do (write-id out id-bytes-lg)
(write-lg-count out len)))
(.write out ba 0 len))))) (.write out ba 0 len)))))
@ -684,17 +664,9 @@
(let [ba (.getBytes s charset) (let [ba (.getBytes s charset)
len (alength ba)] len (alength ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-str-sm) (write-sm-count out len))
(do (write-id out id-str-sm) (md-count? len) (do (write-id out id-str-md) (write-md-count out len))
(write-sm-count out len)) :else (do (write-id out id-str-lg) (write-lg-count out len)))
(md-count? len)
(do (write-id out id-str-md)
(write-md-count out len))
:else
(do (write-id out id-str-lg)
(write-lg-count out len)))
(.write out ba 0 len)))) (.write out ba 0 len))))
@ -703,18 +675,9 @@
ba (.getBytes s charset) ba (.getBytes s charset)
len (alength ba)] len (alength ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-kw-sm) (write-sm-count out len))
(do (write-id out id-kw-sm) (md-count? len) (do (write-id out id-kw-md) (write-md-count out len))
(write-sm-count out len)) ;; :else (do (write-id out id-kw-lg) (write-lg-count out len)) ; Unrealistic
(md-count? len)
(do (write-id out id-kw-md)
(write-md-count out len))
;; :else ; Unrealistic
;; (do (write-id out id-kw-lg)
;; (write-lg-count out len))
:else (throw (ex-info "Keyword too long" {:full-name s}))) :else (throw (ex-info "Keyword too long" {:full-name s})))
(.write out ba 0 len))) (.write out ba 0 len)))
@ -724,62 +687,29 @@
ba (.getBytes s charset) ba (.getBytes s charset)
len (alength ba)] len (alength ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-sym-sm) (write-sm-count out len))
(do (write-id out id-sym-sm) (md-count? len) (do (write-id out id-sym-md) (write-md-count out len))
(write-sm-count out len)) ;; :else (do (write-id out id-sym-lg) (write-lg-count out len)) ; Unrealistic
(md-count? len)
(do (write-id out id-sym-md)
(write-md-count out len))
;; :else ; Unrealistic
;; (do (write-id out id-sym-lg)
;; (write-lg-count out len))
:else (throw (ex-info "Symbol too long" {:full-name s}))) :else (throw (ex-info "Symbol too long" {:full-name s})))
(.write out ba 0 len))) (.write out ba 0 len)))
(defn- write-long [^DataOutput out ^long n] (defn- write-long [^DataOutput out ^long n]
(enc/cond (enc/cond
(zero? n) (zero? n) (write-id out id-long-0)
(write-id out id-long-0) (pos? n)
(> n 0)
(enc/cond (enc/cond
(<= n 127 #_Byte/MAX_VALUE) (<= n Byte/MAX_VALUE) (do (write-id out id-long-sm) (.writeByte out n))
(do (write-id out id-long-sm) (<= n Short/MAX_VALUE) (do (write-id out id-long-md) (.writeShort out n))
(.writeByte out n)) (<= n Integer/MAX_VALUE) (do (write-id out id-long-lg) (.writeInt out n))
:else (do (write-id out id-long-xl) (.writeLong out n)))
(<= n 32767 #_Short/MAX_VALUE)
(do (write-id out id-long-md)
(.writeShort out n))
(<= n 2147483647 #_Integer/MAX_VALUE)
(do (write-id out id-long-lg)
(.writeInt out n))
:else
(do (write-id out id-long-xl)
(.writeLong out n)))
:else :else
(enc/cond (enc/cond
(>= n -128 #_Byte/MIN_VALUE) (>= n Byte/MIN_VALUE) (do (write-id out id-long-sm) (.writeByte out n))
(do (write-id out id-long-sm) (>= n Short/MIN_VALUE) (do (write-id out id-long-md) (.writeShort out n))
(.writeByte out n)) (>= n Integer/MIN_VALUE) (do (write-id out id-long-lg) (.writeInt out n))
:else (do (write-id out id-long-xl) (.writeLong out n)))))
(>= n -32768 #_Short/MIN_VALUE)
(do (write-id out id-long-md)
(.writeShort out n))
(>= n -2147483648 #_Integer/MIN_VALUE)
(do (write-id out id-long-lg)
(.writeInt out n))
:else
(do (write-id out id-long-xl)
(.writeLong out n)))))
(defmacro ^:private -run! [proc coll] `(do (reduce #(~proc %2) nil ~coll) nil)) (defmacro ^:private -run! [proc coll] `(do (reduce #(~proc %2) nil ~coll) nil))
(defmacro ^:private -run-kv! [proc m] `(do (reduce-kv #(~proc %2 %3) nil ~m) nil)) (defmacro ^:private -run-kv! [proc m] `(do (reduce-kv #(~proc %2 %3) nil ~m) nil))
@ -794,17 +724,10 @@
(enc/cond (enc/cond
(== cnt 2) (write-id out id-vec-2) (== cnt 2) (write-id out id-vec-2)
(== cnt 3) (write-id out id-vec-3) (== cnt 3) (write-id out id-vec-3)
:else :else (do (write-id out id-vec-sm) (write-sm-count out cnt)))
(do (write-id out id-vec-sm)
(write-sm-count out cnt)))
(md-count? cnt) (md-count? cnt) (do (write-id out id-vec-md) (write-md-count out cnt))
(do (write-id out id-vec-md) :else (do (write-id out id-vec-lg) (write-lg-count out cnt)))
(write-md-count out cnt))
:else
(do (write-id out id-vec-lg)
(write-lg-count out cnt)))
(-run! (fn [in] (-freeze-with-meta! in out)) v))))) (-run! (fn [in] (-freeze-with-meta! in out)) v)))))
@ -825,17 +748,9 @@
(write-id out id-empty) (write-id out id-empty)
(do (do
(enc/cond (enc/cond
(sm-count? cnt) (sm-count? cnt) (do (write-id out id-sm) (write-sm-count out cnt))
(do (write-id out id-sm) (md-count? cnt) (do (write-id out id-md) (write-md-count out cnt))
(write-sm-count out cnt)) :else (do (write-id out id-lg) (write-lg-count out cnt)))
(md-count? cnt)
(do (write-id out id-md)
(write-md-count out cnt))
:else
(do (write-id out id-lg)
(write-lg-count out cnt)))
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
@ -858,17 +773,9 @@
(write-id out id-empty) (write-id out id-empty)
(do (do
(enc/cond (enc/cond
(sm-count? cnt) (sm-count? cnt) (do (write-id out id-sm) (write-sm-count out cnt))
(do (write-id out id-sm) (md-count? cnt) (do (write-id out id-md) (write-md-count out cnt))
(write-sm-count out cnt)) :else (do (write-id out id-lg) (write-lg-count out cnt)))
(md-count? cnt)
(do (write-id out id-md)
(write-md-count out cnt))
:else
(do (write-id out id-lg)
(write-lg-count out cnt)))
(-run! (fn [in] (-freeze-with-meta! in out)) coll)))))) (-run! (fn [in] (-freeze-with-meta! in out)) coll))))))
@ -894,17 +801,9 @@
(write-id out id-empty) (write-id out id-empty)
(do (do
(enc/cond (enc/cond
(sm-count? cnt) (sm-count? cnt) (do (write-id out id-sm) (write-sm-count out cnt))
(do (write-id out id-sm) (md-count? cnt) (do (write-id out id-md) (write-md-count out cnt))
(write-sm-count out cnt)) :else (do (write-id out id-lg) (write-lg-count out cnt)))
(md-count? cnt)
(do (write-id out id-md)
(write-md-count out cnt))
:else
(do (write-id out id-lg)
(write-lg-count out cnt)))
(.write out ba)))))) (.write out ba))))))
@ -927,17 +826,9 @@
(write-id out id-map-0) (write-id out id-map-0)
(do (do
(enc/cond (enc/cond
(sm-count? cnt) (sm-count? cnt) (do (write-id out id-map-sm) (write-sm-count out cnt))
(do (write-id out id-map-sm) (md-count? cnt) (do (write-id out id-map-md) (write-md-count out cnt))
(write-sm-count out cnt)) :else (do (write-id out id-map-lg) (write-lg-count out cnt)))
(md-count? cnt)
(do (write-id out id-map-md)
(write-md-count out cnt))
:else
(do (write-id out id-map-lg)
(write-lg-count out cnt)))
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
@ -953,17 +844,9 @@
(write-id out id-set-0) (write-id out id-set-0)
(do (do
(enc/cond (enc/cond
(sm-count? cnt) (sm-count? cnt) (do (write-id out id-set-sm) (write-sm-count out cnt))
(do (write-id out id-set-sm) (md-count? cnt) (do (write-id out id-set-md) (write-md-count out cnt))
(write-sm-count out cnt)) :else (do (write-id out id-set-lg) (write-lg-count out cnt)))
(md-count? cnt)
(do (write-id out id-set-md)
(write-md-count out cnt))
:else
(do (write-id out id-set-lg)
(write-lg-count out cnt)))
(-run! (fn [in] (-freeze-with-meta! in out)) s))))) (-run! (fn [in] (-freeze-with-meta! in out)) s)))))
@ -979,18 +862,9 @@
len (alength class-name-ba)] len (alength class-name-ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-sz-quarantined-sm) (write-bytes-sm out class-name-ba))
(do (write-id out id-sz-quarantined-sm) (md-count? len) (do (write-id out id-sz-quarantined-md) (write-bytes-md out class-name-ba))
(write-bytes-sm out class-name-ba)) ;; :else (do (write-id out id-sz-quarantined-lg) (write-bytes-md out class-name-ba)) ; Unrealistic
(md-count? len)
(do (write-id out id-sz-quarantined-md)
(write-bytes-md out class-name-ba))
;; :else ; Unrealistic
;; (do (write-id out id-sz-quarantined-lg)
;; (write-bytes-md out class-name-ba))
:else :else
(throw (throw
(ex-info "Serializable class name too long" (ex-info "Serializable class name too long"
@ -1011,17 +885,9 @@
edn-ba (.getBytes ^String edn charset) edn-ba (.getBytes ^String edn charset)
len (alength edn-ba)] len (alength edn-ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-reader-sm) (write-bytes-sm out edn-ba))
(do (write-id out id-reader-sm) (md-count? len) (do (write-id out id-reader-md) (write-bytes-md out edn-ba))
(write-bytes-sm out edn-ba)) :else (do (write-id out id-reader-lg) (write-bytes-lg 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] (defn try-write-serializable [out x]
(when (and (instance? Serializable x) (not (fn? x))) (when (and (instance? Serializable x) (not (fn? x)))
@ -1120,7 +986,7 @@
(let [x-val (.-val x)] (let [x-val (.-val x)]
(if-let [cache_ (.get -cache-proxy)] (if-let [cache_ (.get -cache-proxy)]
(let [cache @cache_ (let [cache @cache_
k #_x-val [x-val (meta x-val)] k #_x-val [x-val (meta x-val)] ; Also check meta for equality
?idx (get cache k) ?idx (get cache k)
^int idx (or ?idx ^int idx (or ?idx
(let [idx (count cache)] (let [idx (count cache)]
@ -1218,9 +1084,8 @@
(freezer Long (write-long out x)) (freezer Long (write-long out x))
(freezer Double (freezer Double
(if (zero? ^double x) (if (zero? ^double x)
(write-id out id-double-0) (do (write-id out id-double-0))
(do (write-id out id-double) (do (write-id out id-double) (.writeDouble out x))))
(.writeDouble out x))))
(freezer PersistentQueue (write-counted-coll out id-queue-lg x)) (freezer PersistentQueue (write-counted-coll out id-queue-lg x))
(freezer PersistentTreeSet (write-counted-coll out id-sorted-set-lg x)) (freezer PersistentTreeSet (write-counted-coll out id-sorted-set-lg x))
@ -1236,18 +1101,9 @@
class-name-ba (.getBytes class-name charset) class-name-ba (.getBytes class-name charset)
len (alength class-name-ba)] len (alength class-name-ba)]
(enc/cond (enc/cond
(sm-count? len) (sm-count? len) (do (write-id out id-record-sm) (write-bytes-sm out class-name-ba))
(do (write-id out id-record-sm) (md-count? len) (do (write-id out id-record-md) (write-bytes-md out class-name-ba))
(write-bytes-sm out class-name-ba)) ;; :else (do (write-id out id-record-lg) (write-bytes-md out class-name-ba)) ; Unrealistic
(md-count? len)
(do (write-id out id-record-md)
(write-bytes-md out class-name-ba))
;; :else ; Unrealistic
;; (do (write-id out id-record-lg)
;; (write-bytes-md out class-name-ba))
:else :else
(throw (throw
(ex-info "Record class name too long" (ex-info "Record class name too long"
@ -1381,8 +1237,8 @@
(.toByteArray baos))) (.toByteArray baos)))
(defn freeze (defn freeze
"Serializes arg (any Clojure data type) to a byte array. To freeze custom "Serializes arg (any Clojure data type) to a byte array.
types, extend the Clojure reader or see `extend-freeze`." To freeze custom types, extend the Clojure reader or see `extend-freeze`."
([x] (freeze x nil)) ([x] (freeze x nil))
([x {:as opts ([x {:as opts
@ -1392,7 +1248,6 @@
(call-with-bindings :freeze opts (call-with-bindings :freeze opts
(fn [] (fn []
(let [;; Intentionally undocumented: (let [;; Intentionally undocumented:
no-header? (or (get opts :no-header?) no-header? (or (get opts :no-header?)
(get opts :skip-header?)) (get opts :skip-header?))
@ -1433,17 +1288,8 @@
(if no-header? (if no-header?
ba ba
(wrap-header ba (wrap-header ba
{:compressor-id {:compressor-id (when-let [c compressor] (or (compression/standard-header-ids (compression/header-id c)) :else))
(when-let [c compressor] :encryptor-id (when-let [e encryptor] (or (encryption/standard-header-ids (encryption/header-id e)) :else))}))))))))))
(or (compression/standard-header-ids
(compression/header-id c))
:else))
:encryptor-id
(when-let [e encryptor]
(or (encryption/standard-header-ids
(encryption/header-id e))
:else))}))))))))))
;;;; Thawing ;;;; Thawing
@ -1512,13 +1358,11 @@
(throw (throw
(ex-info (ex-info
(str "Reader exception for custom type id: " type-id) (str "Reader exception for custom type id: " type-id)
{:type-id type-id {:type-id type-id, :prefixed? prefixed?} e))))
:prefixed? prefixed?} e))))
(throw (throw
(ex-info (ex-info
(str "No reader provided for custom type id: " type-id) (str "No reader provided for custom type id: " type-id)
{:type-id type-id {:type-id type-id, :prefixed? prefixed?}))))
:prefixed? prefixed?}))))
(defn- read-edn [edn] (defn- read-edn [edn]
(try (try
@ -1649,6 +1493,7 @@
[^DataInput data-input] [^DataInput data-input]
(let [in data-input (let [in data-input
type-id (.readByte in)] type-id (.readByte in)]
(when-debug (println (str "thaw-from-in!: " type-id))) (when-debug (println (str "thaw-from-in!: " type-id)))
(try (try
(enc/case-eval type-id (enc/case-eval type-id
@ -1659,7 +1504,7 @@
id-reader-lg_ (read-edn (read-str in (read-lg-count in))) id-reader-lg_ (read-edn (read-str in (read-lg-count in)))
id-record-sm (read-record in (read-str in (read-sm-count in))) id-record-sm (read-record in (read-str in (read-sm-count in)))
id-record-md (read-record in (read-str in (read-md-count in))) id-record-md (read-record in (read-str in (read-md-count in)))
id-record-lg (read-record in (read-str in (read-lg-count in))) id-record-lg_ (read-record in (read-str in (read-lg-count in)))
id-sz-quarantined-sm (read-sz-quarantined in (read-str in (read-sm-count in))) id-sz-quarantined-sm (read-sz-quarantined in (read-str in (read-sm-count in)))
id-sz-quarantined-md (read-sz-quarantined in (read-str in (read-md-count in))) id-sz-quarantined-md (read-sz-quarantined in (read-str in (read-md-count in)))
@ -1705,12 +1550,12 @@
id-kw-sm (keyword (read-str in (read-sm-count in))) id-kw-sm (keyword (read-str in (read-sm-count in)))
id-kw-md (keyword (read-str in (read-md-count in))) id-kw-md (keyword (read-str in (read-md-count in)))
id-kw-md_ (keyword (read-str in (read-lg-count in))) id-kw-md_ (keyword (read-str in (read-lg-count in)))
id-kw-lg (keyword (read-str in (read-lg-count in))) id-kw-lg_ (keyword (read-str in (read-lg-count in)))
id-sym-sm (symbol (read-str in (read-sm-count in))) id-sym-sm (symbol (read-str in (read-sm-count in)))
id-sym-md (symbol (read-str in (read-md-count in))) id-sym-md (symbol (read-str in (read-md-count in)))
id-sym-md_ (symbol (read-str in (read-lg-count in))) id-sym-md_ (symbol (read-str in (read-lg-count in)))
id-sym-lg (symbol (read-str in (read-lg-count in))) id-sym-lg_ (symbol (read-str in (read-lg-count in)))
id-regex (re-pattern (thaw-from-in! in)) id-regex (re-pattern (thaw-from-in! in))
id-vec-0 [] id-vec-0 []
@ -1830,9 +1675,10 @@
(str "Unrecognized type id (" type-id "). Data frozen with newer Nippy version?") (str "Unrecognized type id (" type-id "). Data frozen with newer Nippy version?")
{:type-id type-id})))) {:type-id type-id}))))
(catch Exception e (catch Throwable t
(throw (ex-info (str "Thaw failed against type-id: " type-id) (throw
{:type-id type-id} e)))))) (ex-info (str "Thaw failed against type-id: " type-id)
{:type-id type-id} t))))))
(let [head-sig head-sig] ; Not ^:const (let [head-sig head-sig] ; Not ^:const
(defn- try-parse-header [^bytes ba] (defn- try-parse-header [^bytes ba]
@ -1866,11 +1712,8 @@
(do (throw (ex-info (str "Unrecognized :auto encryptor id: " encryptor-id) (do (throw (ex-info (str "Unrecognized :auto encryptor id: " encryptor-id)
{:encryptor-id encryptor-id}))))) {:encryptor-id encryptor-id})))))
(def ^:private err-msg-unknown-thaw-failure (def ^:private err-msg-unknown-thaw-failure "Decryption/decompression failure, or data unfrozen/damaged.")
"Decryption/decompression failure, or data unfrozen/damaged.") (def ^:private err-msg-unrecognized-header "Unrecognized (but apparently well-formed) header. Data frozen with newer Nippy version?")
(def ^:private err-msg-unrecognized-header
"Unrecognized (but apparently well-formed) header. Data frozen with newer Nippy version?")
(defn fast-thaw (defn fast-thaw
"Like `thaw` but: "Like `thaw` but:
@ -1912,12 +1755,14 @@
(call-with-bindings :thaw opts (call-with-bindings :thaw opts
(fn [] (fn []
(let [v2+? (not v1-compatibility?) (let [v2+? (not v1-compatibility?)
no-header? (get opts :no-header?) ; Intentionally undocumented no-header? (get opts :no-header?) ; Intentionally undocumented
ex (fn ex ex
(fn ex
([ msg] (ex nil msg)) ([ msg] (ex nil msg))
([e msg] (throw (ex-info (str "Thaw failed: " msg) ([e msg]
(throw
(ex-info (str "Thaw failed. " msg)
{:opts (assoc opts {:opts (assoc opts
:compressor compressor :compressor compressor
:encryptor encryptor)} :encryptor encryptor)}
@ -1925,12 +1770,8 @@
thaw-data thaw-data
(fn [data-ba compressor-id encryptor-id ex-fn] (fn [data-ba compressor-id encryptor-id ex-fn]
(let [compressor (if (identical? compressor :auto) (let [compressor (if (identical? compressor :auto) (get-auto-compressor compressor-id) compressor)
(get-auto-compressor compressor-id) encryptor (if (identical? encryptor :auto) (get-auto-encryptor encryptor-id) encryptor)]
compressor)
encryptor (if (identical? encryptor :auto)
(get-auto-encryptor encryptor-id)
encryptor)]
(when (and encryptor (not password)) (when (and encryptor (not password))
(ex "Password required for decryption.")) (ex "Password required for decryption."))
@ -1955,8 +1796,7 @@
(if no-header? (if no-header?
(if v2+? (if v2+?
(thaw-data ba :no-header :no-header (fn [e] (ex e err-msg-unknown-thaw-failure))) (thaw-data ba :no-header :no-header (fn [e] (ex e err-msg-unknown-thaw-failure)))
(thaw-data ba :no-header :no-header (thaw-data ba :no-header :no-header (fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure))))))
(fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure))))))
;; At this point we assume that we have a header iff we have v2+ data ;; At this point we assume that we have a header iff we have v2+ data
(if-let [[data-ba {:keys [compressor-id encryptor-id unrecognized-meta?] (if-let [[data-ba {:keys [compressor-id encryptor-id unrecognized-meta?]
@ -1972,8 +1812,7 @@
(if unrecognized-meta? (if unrecognized-meta?
(thaw-v1-data ba (fn [_] (ex err-msg-unrecognized-header))) (thaw-v1-data ba (fn [_] (ex err-msg-unrecognized-header)))
(thaw-data data-ba compressor-id encryptor-id (thaw-data data-ba compressor-id encryptor-id (fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure)))))))
(fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure)))))))
;; Well-formed header definitely not present ;; Well-formed header definitely not present
(if v2+? (if v2+?
@ -2003,8 +1842,9 @@
short-hash-id (if (pos? hash-id) short-hash-id (if (pos? hash-id)
(mod hash-id Short/MAX_VALUE) (mod hash-id Short/MAX_VALUE)
(mod hash-id Short/MIN_VALUE))] (mod hash-id Short/MIN_VALUE))]
;; Make sure hash ids can't collide with byte ids (unlikely anyway): ;; Make sure hash ids can't collide with byte ids (unlikely anyway):
(assert (not (<= -128 short-hash-id -1)) (assert (not (<= Byte/MIN_VALUE short-hash-id -1))
"Custom type id hash collision; please choose a different id") "Custom type id hash collision; please choose a different id")
(int short-hash-id)))) (int short-hash-id))))
@ -2134,7 +1974,7 @@
:bigdec (bigdec 3.1415926535897932384626433832795) :bigdec (bigdec 3.1415926535897932384626433832795)
:ratio 22/7 :ratio 22/7
:uri (URI. "https://clojure.org/reference/data_structures") :uri (java.net.URI. "https://clojure.org/reference/data_structures")
:uuid (java.util.UUID/randomUUID) :uuid (java.util.UUID/randomUUID)
:date (java.util.Date.) :date (java.util.Date.)
@ -2167,7 +2007,8 @@
;;;; Tools ;;;; Tools
(defn inspect-ba "Alpha - subject to change" (defn inspect-ba
"Experimental, subject to change. Feedback welcome."
([ba ] (inspect-ba ba nil)) ([ba ] (inspect-ba ba nil))
([ba thaw-opts] ([ba thaw-opts]
(when (enc/bytes? ba) (when (enc/bytes? ba)
@ -2192,7 +2033,7 @@
:data-len (alength ^bytes data-ba)})))) :data-len (alength ^bytes data-ba)}))))
(comment (comment
(inspect-ba (freeze "hello")) (do (inspect-ba (freeze "hello")))
(seq (:data-ba (inspect-ba (freeze "hello"))))) (seq (:data-ba (inspect-ba (freeze "hello")))))
(defn freeze-to-string (defn freeze-to-string
@ -2257,11 +2098,11 @@
;;;; Deprecated ;;;; Deprecated
(enc/deprecated (enc/deprecated
(def freeze-fallback-as-str "DEPRECATED, use `write-unfreezable`" write-unfreezable) (def ^:deprecated freeze-fallback-as-str "DEPRECATED, use `write-unfreezable`" write-unfreezable)
(defn set-freeze-fallback! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*freeze-fallback* (constantly x))) (defn ^:deprecated set-freeze-fallback! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*freeze-fallback* (constantly x)))
(defn set-auto-freeze-compressor! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*auto-freeze-compressor* (constantly x))) (defn ^:deprecated set-auto-freeze-compressor! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*auto-freeze-compressor* (constantly x)))
(defn swap-custom-readers! "DEPRECATED, just use `alter-var-root`" [f] (alter-var-root #'*custom-readers* f)) (defn ^:deprecated swap-custom-readers! "DEPRECATED, just use `alter-var-root`" [f] (alter-var-root #'*custom-readers* f))
(defn swap-serializable-whitelist! (defn ^:deprecated swap-serializable-whitelist!
"DEPRECATED, just use "DEPRECATED, just use
(alter-var-root *thaw-serializable-allowlist* f) and/or (alter-var-root *thaw-serializable-allowlist* f) and/or
(alter-var-root *freeze-serializable-allow-list* f) instead." (alter-var-root *freeze-serializable-allow-list* f) instead."

1
src/taoensso/nippy/benchmarks.clj
View file

@ -1,4 +1,5 @@
(ns taoensso.nippy.benchmarks (ns taoensso.nippy.benchmarks
"Nippy benchmarks."
(:require [clojure.data.fressian :as fressian] (:require [clojure.data.fressian :as fressian]
[taoensso.encore :as enc] [taoensso.encore :as enc]
[taoensso.nippy :as nippy :refer [freeze thaw]])) [taoensso.nippy :as nippy :refer [freeze thaw]]))

3
src/taoensso/nippy/compression.clj
View file

@ -1,4 +1,5 @@
(ns taoensso.nippy.compression (ns ^:no-doc taoensso.nippy.compression
"Private, implementation detail."
(:require [taoensso.encore :as enc]) (:require [taoensso.encore :as enc])
(:import [java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream (:import [java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream
DataOutputStream])) DataOutputStream]))

2
src/taoensso/nippy/crypto.clj
View file

@ -1,4 +1,4 @@
(ns taoensso.nippy.crypto (ns ^:no-doc taoensso.nippy.crypto
"Low-level crypto utils. "Low-level crypto utils.
Private & alpha, very likely to change!" Private & alpha, very likely to change!"
(:refer-clojure :exclude [rand-nth]) (:refer-clojure :exclude [rand-nth])

6
src/taoensso/nippy/encryption.clj
View file

@ -1,11 +1,11 @@
(ns taoensso.nippy.encryption (ns ^:no-doc taoensso.nippy.encryption
"Simple no-nonsense crypto with reasonable defaults" "Private, implementation detail."
(:require (:require
[taoensso.encore :as enc] [taoensso.encore :as enc]
[taoensso.nippy.crypto :as crypto])) [taoensso.nippy.crypto :as crypto]))
(def standard-header-ids (def standard-header-ids
"These'll support :auto thaw" "These'll support `:auto` thaw."
#{:aes128-cbc-sha512 #{:aes128-cbc-sha512
:aes128-gcm-sha512}) :aes128-gcm-sha512})

3
src/taoensso/nippy/utils.clj
View file

@ -1,4 +1,5 @@
(ns taoensso.nippy.utils (ns ^:no-doc taoensso.nippy.utils
"Private, implementation detail."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[taoensso.encore :as enc]) [taoensso.encore :as enc])
(:import [java.io ByteArrayInputStream ByteArrayOutputStream Serializable (:import [java.io ByteArrayInputStream ByteArrayOutputStream Serializable