Trying to reduce encore footprint
This commit is contained in:
Chris Nuernberger
parent
d0ad2884a7
commit
f8ea0cef2a
6 changed files with 586 additions and 26 deletions
573
src/taoensso/min_encore.clj
Normal file
573
src/taoensso/min_encore.clj
Normal file
|
|
@ -0,0 +1,573 @@
|
|||
(ns taoensso.min-encore
|
||||
(:require [clojure.tools.reader.edn :as tools-edn]
|
||||
[clojure.string :as str])
|
||||
(:import [java.util.function Function BiFunction])
|
||||
(:refer-clojure :exclude
|
||||
[defonce if-let if-not if-some when when-not when-some when-let cond]))
|
||||
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(def -core-merge clojure.core/merge)
|
||||
(def -core-update-in clojure.core/update-in)
|
||||
|
||||
|
||||
(defmacro defalias "Defines an alias for a var, preserving its metadata."
|
||||
([ src ] `(defalias ~(symbol (name src)) ~src nil))
|
||||
([sym src ] `(defalias ~sym ~src nil))
|
||||
([sym src attrs]
|
||||
(let [attrs (if (string? attrs) {:doc attrs} attrs)] ; Back compatibility
|
||||
`(let [src-var# (var ~src)
|
||||
dst-var# (def ~sym (.getRawRoot src-var#))]
|
||||
(alter-meta! dst-var#
|
||||
#(-core-merge %
|
||||
(dissoc (meta src-var#) :column :line :file :ns :test :name)
|
||||
~attrs))
|
||||
dst-var#))))
|
||||
|
||||
|
||||
(defn name-with-attrs
|
||||
"Given a symbol and args, returns [<name-with-attrs-meta> <args>] with
|
||||
support for `defn` style `?docstring` and `?attrs-map`."
|
||||
([sym args ] (name-with-attrs sym args nil))
|
||||
([sym args attrs-merge]
|
||||
(let [[?docstring args] (if (and (string? (first args)) (next args)) [(first args) (next args)] [nil args])
|
||||
[attrs args] (if (and (map? (first args)) (next args)) [(first args) (next args)] [{} args])
|
||||
attrs (if ?docstring (assoc attrs :doc ?docstring) attrs)
|
||||
attrs (if (meta sym) (conj (meta sym) attrs) attrs)
|
||||
attrs (conj attrs attrs-merge)]
|
||||
[(with-meta sym attrs) args])))
|
||||
|
||||
|
||||
(defmacro defonce
|
||||
"Like `core/defonce` but supports optional docstring and attrs map."
|
||||
{:style/indent 1}
|
||||
[sym & args]
|
||||
(let [[sym body] (name-with-attrs sym args)]
|
||||
`(clojure.core/defonce ~sym ~@body)))
|
||||
|
||||
|
||||
(defmacro if-let
|
||||
"Like `core/if-let` but can bind multiple values for `then` iff all tests
|
||||
are truthy, supports internal unconditional `:let`s."
|
||||
{:style/indent 1}
|
||||
([bindings then ] `(if-let ~bindings ~then nil))
|
||||
([bindings then else]
|
||||
(let [s (seq bindings)]
|
||||
(if s ; (if-let [] true false) => true
|
||||
(let [[b1 b2 & bnext] s]
|
||||
(if (= b1 :let)
|
||||
`(let ~b2 (if-let ~(vec bnext) ~then ~else))
|
||||
`(let [b2# ~b2]
|
||||
(if b2#
|
||||
(let [~b1 b2#]
|
||||
(if-let ~(vec bnext) ~then ~else))
|
||||
~else))))
|
||||
then))))
|
||||
|
||||
(defmacro if-some
|
||||
"Like `core/if-some` but can bind multiple values for `then` iff all tests
|
||||
are non-nil, supports internal unconditional `:let`s."
|
||||
{:style/indent 1}
|
||||
([bindings then] `(if-some ~bindings ~then nil))
|
||||
([bindings then else]
|
||||
(let [s (seq bindings)]
|
||||
(if s ; (if-some [] true false) => true
|
||||
(let [[b1 b2 & bnext] s]
|
||||
(if (= b1 :let)
|
||||
`(let ~b2 (if-some ~(vec bnext) ~then ~else))
|
||||
`(let [b2# ~b2]
|
||||
(if (nil? b2#)
|
||||
~else
|
||||
(let [~b1 b2#]
|
||||
(if-some ~(vec bnext) ~then ~else))))))
|
||||
then))))
|
||||
|
||||
(defmacro if-not
|
||||
"Like `core/if-not` but acts like `if-let` when given a binding vector
|
||||
as test expr."
|
||||
;; Also avoids unnecessary `(not test)`
|
||||
{:style/indent 1}
|
||||
([test-or-bindings then]
|
||||
(if (vector? test-or-bindings)
|
||||
`(if-let ~test-or-bindings nil ~then)
|
||||
`(if ~test-or-bindings nil ~then)))
|
||||
|
||||
([test-or-bindings then else]
|
||||
(if (vector? test-or-bindings)
|
||||
`(if-let ~test-or-bindings ~else ~then)
|
||||
`(if ~test-or-bindings ~else ~then))))
|
||||
|
||||
(defmacro when
|
||||
"Like `core/when` but acts like `when-let` when given a binding vector
|
||||
as test expr."
|
||||
{:style/indent 1}
|
||||
[test-or-bindings & body]
|
||||
(if (vector? test-or-bindings)
|
||||
`(if-let ~test-or-bindings (do ~@body) nil)
|
||||
`(if ~test-or-bindings (do ~@body) nil)))
|
||||
|
||||
(defmacro when-not
|
||||
"Like `core/when-not` but acts like `when-let` when given a binding vector
|
||||
as test expr."
|
||||
{:style/indent 1}
|
||||
[test-or-bindings & body]
|
||||
(if (vector? test-or-bindings)
|
||||
`(if-let ~test-or-bindings nil (do ~@body))
|
||||
`(if ~test-or-bindings nil (do ~@body))))
|
||||
|
||||
(defmacro when-some
|
||||
{:style/indent 1}
|
||||
[test-or-bindings & body]
|
||||
(if (vector? test-or-bindings)
|
||||
`(if-some ~test-or-bindings (do ~@body) nil)
|
||||
`(if (nil? ~test-or-bindings) nil (do ~@body))))
|
||||
|
||||
(defmacro when-let
|
||||
"Like `core/when-let` but can bind multiple values for `body` iff all tests
|
||||
are truthy, supports internal unconditional `:let`s."
|
||||
{:style/indent 1}
|
||||
;; Now a feature subset of all-case `when`
|
||||
[bindings & body] `(if-let ~bindings (do ~@body)))
|
||||
|
||||
|
||||
(defmacro cond
|
||||
"Like `core/cond` but supports implicit final `else` clause, and special
|
||||
clause keywords for advanced behaviour:
|
||||
|
||||
(cond
|
||||
:let [x \"x\"] ; Establish bindings visible to following forms
|
||||
|
||||
:do (println (str \"x value: \" x)) ; Eval expr for side effects
|
||||
|
||||
:if-let [y \"y\"
|
||||
z nil]
|
||||
\"y and z were both truthy\"
|
||||
|
||||
:if-some [y \"y\"
|
||||
z nil]
|
||||
\"y and z were both non-nil\")
|
||||
|
||||
:let support inspired by https://github.com/Engelberg/better-cond.
|
||||
Simple, flexible way to eliminate deeply-nested control flow code."
|
||||
|
||||
;; Also avoids unnecessary `(if :else ...)`, etc.
|
||||
[& clauses]
|
||||
(when-let [[test expr & more] (seq clauses)]
|
||||
(if-not (next clauses)
|
||||
test ; Implicit else
|
||||
(case test
|
||||
(true :else :default) expr ; Faster than (if <truthy> ...)
|
||||
(false nil) `(cond ~@more) ; Faster than (if <falsey> ...)
|
||||
:do `(do ~expr (cond ~@more))
|
||||
:let `(let ~expr (cond ~@more))
|
||||
:when `(when ~expr (cond ~@more)) ; Undocumented
|
||||
:when-not `(when-not ~expr (cond ~@more)) ; Undocumented
|
||||
:when-some `(when-some ~expr (cond ~@more)) ; Undocumented
|
||||
:return-when `(if-let [x# ~expr] x# (cond ~@more)) ; Undocumented
|
||||
:return-some `(if-some [x# ~expr] x# (cond ~@more)) ; Undocumented
|
||||
:if-let `(if-let ~expr ~(first more) (cond ~@(next more)))
|
||||
:if-some `(if-some ~expr ~(first more) (cond ~@(next more)))
|
||||
:if-not `(if-not ~expr ~(first more) (cond ~@(next more))) ; Undocumented
|
||||
|
||||
(if (keyword? test)
|
||||
(throw ; Undocumented, but throws at compile-time so easy to catch
|
||||
(ex-info "Unrecognized `encore/cond` keyword in `test` clause"
|
||||
{:test-form test :expr-form expr}))
|
||||
|
||||
(if (vector? test) ; Undocumented
|
||||
`(if-let ~test ~expr (cond ~@more))
|
||||
|
||||
;; Experimental, assumes `not` = `core/not`:
|
||||
(if (and (list? test) (= (first test) 'not))
|
||||
`(if ~(second test) (cond ~@more) ~expr)
|
||||
`(if ~test ~expr (cond ~@more)))))))))
|
||||
|
||||
|
||||
(defmacro cond!
|
||||
"Like `cond` but throws on non-match like `case` and `condp`."
|
||||
[& clauses]
|
||||
(if (odd? (count clauses))
|
||||
`(cond ~@clauses) ; Has implicit else clause
|
||||
`(cond ~@clauses :else (throw (ex-info "No matching `encore/cond!` clause" {})))))
|
||||
|
||||
|
||||
(defmacro case-eval
|
||||
"Like `case` but evals test constants for their compile-time value."
|
||||
{:style/indent 1}
|
||||
[expr & clauses]
|
||||
(let [default (when (odd? (count clauses)) (last clauses))
|
||||
clauses (if default (butlast clauses) clauses)]
|
||||
`(case ~expr
|
||||
~@(map-indexed (fn [i# form#] (if (even? i#) (eval form#) form#)) clauses)
|
||||
~(when default default))))
|
||||
|
||||
|
||||
(defn read-edn
|
||||
"Attempts to pave over differences in:
|
||||
`clojure.edn/read-string`, `clojure.tools.edn/read-string`,
|
||||
`cljs.reader/read-string`, `cljs.tools.reader/read-string`.
|
||||
`cljs.reader` in particular can be a pain."
|
||||
|
||||
([ s] (read-edn nil s))
|
||||
([opts s]
|
||||
;; First normalize behaviour for unexpected inputs:
|
||||
(if (or (nil? s) (identical? s ""))
|
||||
nil
|
||||
(if-not (string? s)
|
||||
(throw (ex-info "`read-edn` attempt against non-nil, non-string arg"
|
||||
{:given s :type (type s)}))
|
||||
|
||||
(let [readers (get opts :readers ::dynamic)
|
||||
default (get opts :default ::dynamic)
|
||||
|
||||
;; Nb we ignore as implementation[1] detail:
|
||||
;; *.tools.reader/*data-readers*,
|
||||
;; *.tools.reader/default-data-reader-fn*
|
||||
;;
|
||||
;; [1] Lib consumer doesn't care that we've standardized to
|
||||
;; using tools.reader under the covers
|
||||
|
||||
readers
|
||||
(if-not (identical? readers ::dynamic)
|
||||
readers
|
||||
clojure.core/*data-readers*)
|
||||
|
||||
default
|
||||
(if-not (identical? default ::dynamic)
|
||||
default
|
||||
clojure.core/*default-data-reader-fn*)
|
||||
|
||||
opts (assoc opts :readers readers :default default)]
|
||||
(tools-edn/read-string opts s))))))
|
||||
|
||||
|
||||
(defn pr-edn
|
||||
"Prints arg to an edn string readable with `read-edn`."
|
||||
([ x] (pr-edn nil x))
|
||||
([_opts x]
|
||||
(let [sw (java.io.StringWriter.)]
|
||||
(binding [*print-level* nil, *print-length* nil,
|
||||
;; *out* sw, *print-dup* false
|
||||
]
|
||||
;; (pr x)
|
||||
(print-method x sw) ; Bypass *out*, *print-dup*
|
||||
(.toString sw)))))
|
||||
|
||||
|
||||
(defn get-sys-val ([id] (get-sys-val id id)) ([prop-id env-id] (or (System/getProperty prop-id) (System/getenv env-id))))
|
||||
(defn read-sys-val ([id] (read-sys-val id id)) ([prop-id env-id] (when-let [s (get-sys-val prop-id env-id)] (read-edn s))))
|
||||
|
||||
|
||||
(defn memoize_
|
||||
"Like `core/memoize` but faster, non-racy, and supports invalidation."
|
||||
[f]
|
||||
(let [nil-sentinel (Object.)
|
||||
;;Concurrent hash maps have per-bucket locking if you use the compute* operators.
|
||||
cache_ (java.util.concurrent.ConcurrentHashMap.)]
|
||||
|
||||
(fn
|
||||
([ ] (.computeIfAbsent
|
||||
cache_ nil-sentinel
|
||||
(reify Function
|
||||
(apply [this k]
|
||||
(f)))))
|
||||
|
||||
([& xs]
|
||||
(let [x1 (first xs)]
|
||||
|
||||
(cond
|
||||
(= x1 :mem/del)
|
||||
(let [xn (next xs)
|
||||
x2 (first xn)]
|
||||
(if (= x2 :mem/all)
|
||||
(.clear cache_)
|
||||
(.remove cache_ (or xn nil-sentinel)))
|
||||
nil)
|
||||
|
||||
(= x1 :mem/fresh)
|
||||
(let [xn (next xs)]
|
||||
(.compute cache_ (or xn nil-sentinel)
|
||||
(reify BiFunction
|
||||
(apply [this k v]
|
||||
(apply f xn)))))
|
||||
|
||||
:else
|
||||
(.computeIfAbsent
|
||||
cache_ nil-sentinel
|
||||
(reify Function
|
||||
(apply [this k]
|
||||
(apply f xs))))))))))
|
||||
|
||||
|
||||
(defn fmemoize
|
||||
"Fastest-possible Clj memoize. Non-racy, 0-3 arity only.
|
||||
Cljs just passes through to `core/memoize`."
|
||||
[f]
|
||||
;; Non-racey just as fast as racey, and protects against nils in maps
|
||||
(let [cache0_ (java.util.concurrent.atomic.AtomicReference. nil)
|
||||
cache1_ (java.util.concurrent.ConcurrentHashMap.)
|
||||
cachen_ (java.util.concurrent.ConcurrentHashMap.)]
|
||||
|
||||
(fn
|
||||
([ ]
|
||||
@(or
|
||||
(.get cache0_)
|
||||
(let [dv (delay (f))]
|
||||
(if (.compareAndSet cache0_ nil dv)
|
||||
dv
|
||||
(.get cache0_)))))
|
||||
|
||||
([x]
|
||||
(.computeIfAbsent cache1_ x
|
||||
(reify Function
|
||||
(apply [this v]
|
||||
(f v)))))
|
||||
([x1 x2]
|
||||
(let [xs [x1 x2]]
|
||||
(.computeIfAbsent cachen_ xs
|
||||
(reify Function
|
||||
(apply [this v]
|
||||
(f x1 x2))))))
|
||||
([x1 x2 x3]
|
||||
(let [xs [x1 x2 x3]]
|
||||
(.computeIfAbsent cachen_ xs
|
||||
(reify Function
|
||||
(apply [this v]
|
||||
(f x1 x2 x3)))))))))
|
||||
|
||||
|
||||
(def ^:private ^:const atom-tag 'clojure.lang.IAtom)
|
||||
|
||||
|
||||
(defmacro -if-cas! "Micro optimization, mostly for cljs."
|
||||
[atom_ old-val new-val then & [?else]]
|
||||
`(if (.compareAndSet ~(with-meta atom_ {:tag atom-tag}) ~old-val ~new-val)
|
||||
~then
|
||||
~?else))
|
||||
|
||||
|
||||
(defn -swap-val!
|
||||
"Used internally by memoization utils."
|
||||
[atom_ k f]
|
||||
(loop []
|
||||
(let [m0 @atom_
|
||||
v1 (f (get m0 k))
|
||||
m1 (assoc m0 k v1)]
|
||||
(-if-cas! atom_ m0 m1
|
||||
v1
|
||||
(recur)))))
|
||||
|
||||
|
||||
|
||||
(defmacro thread-local-proxy
|
||||
[& body] `(proxy [ThreadLocal] [] (initialValue [] (do ~@body))))
|
||||
|
||||
(def ^:private srng* (thread-local-proxy (java.security.SecureRandom/getInstanceStrong)))
|
||||
|
||||
(defn secure-rng
|
||||
"Returns a thread-local `java.security.SecureRandom`.
|
||||
Favours security over performance. Automatically re-seeds occasionally.
|
||||
May block while waiting on system entropy!"
|
||||
^java.security.SecureRandom []
|
||||
(let [rng ^java.security.SecureRandom (.get ^ThreadLocal srng*)]
|
||||
;; Occasionally supplement current seed for extra security.
|
||||
;; Otherwise an attacker could *theoretically* observe large amounts of
|
||||
;; srng output to determine initial seed, Ref. https://goo.gl/MPM91w
|
||||
(when (< (.nextDouble rng) 2.44140625E-4) (.setSeed rng (.generateSeed rng 8)))
|
||||
rng))
|
||||
|
||||
|
||||
(defn ba-concat ^bytes [^bytes ba1 ^bytes ba2]
|
||||
(let [s1 (alength ba1)
|
||||
s2 (alength ba2)
|
||||
out (byte-array (+ s1 s2))]
|
||||
(System/arraycopy ba1 0 out 0 s1)
|
||||
(System/arraycopy ba2 0 out s1 s2)
|
||||
out))
|
||||
|
||||
|
||||
(defn ba-split [^bytes ba ^long idx]
|
||||
(if (zero? idx)
|
||||
[nil ba]
|
||||
(let [s (alength ba)]
|
||||
(when (> s idx)
|
||||
[(java.util.Arrays/copyOf ba idx)
|
||||
(java.util.Arrays/copyOfRange ba idx s)]))))
|
||||
|
||||
(defn ba= [^bytes x ^bytes y] (java.util.Arrays/equals x y))
|
||||
|
||||
|
||||
(defn rsome [pred coll] (reduce (fn [acc in] (when-let [p (pred in)] (reduced p))) nil coll))
|
||||
(defn rsome-kv [pred coll] (reduce-kv (fn [acc k v] (when-let [p (pred k v)] (reduced p))) nil coll))
|
||||
(defn rfirst [pred coll] (reduce (fn [acc in] (when (pred in) (reduced in))) nil coll))
|
||||
(defn rfirst-kv [pred coll] (reduce-kv (fn [acc k v] (when (pred k v) (reduced [k v]))) nil coll))
|
||||
(defn revery? [pred coll] (reduce (fn [acc in] (if (pred in) true (reduced false))) true coll))
|
||||
(defn revery-kv? [pred coll] (reduce-kv (fn [acc k v] (if (pred k v) true (reduced false))) true coll))
|
||||
(defn revery [pred coll] (reduce (fn [acc in] (if (pred in) coll (reduced nil))) coll coll))
|
||||
(defn revery-kv [pred coll] (reduce-kv (fn [acc k v] (if (pred k v) coll (reduced nil))) coll coll))
|
||||
(defn reduce-n
|
||||
([rf init end] (reduce rf init (range end)))
|
||||
([rf init start end] (reduce rf init (range start end))))
|
||||
|
||||
(defmacro new-object [] `(Object.))
|
||||
|
||||
|
||||
(defn rcompare "Reverse comparator."
|
||||
{:inline (fn [x y] `(. clojure.lang.Util compare ~y ~x))}
|
||||
[x y] (compare y x))
|
||||
|
||||
|
||||
(defn editable? [x] (instance? clojure.lang.IEditableCollection x))
|
||||
(defn queue? [x] (instance? clojure.lang.PersistentQueue x))
|
||||
(defn queue "Returns a PersistentQueue."
|
||||
([coll] (into (queue) coll))
|
||||
([] clojure.lang.PersistentQueue/EMPTY))
|
||||
|
||||
|
||||
(defn repeatedly-into
|
||||
"Like `repeatedly` but faster and `conj`s items into given collection."
|
||||
[coll ^long n f]
|
||||
(if (and (> n 10) (editable? coll))
|
||||
(persistent! (reduce-n (fn [acc _] (conj! acc (f))) (transient coll) n))
|
||||
(do (reduce-n (fn [acc _] (conj acc (f))) coll n))))
|
||||
|
||||
|
||||
(defn str-contains?
|
||||
[s substr]
|
||||
(.contains ^String s ^String substr))
|
||||
|
||||
|
||||
(defn re-pattern? [x] (instance? java.util.regex.Pattern x))
|
||||
|
||||
|
||||
(let [sentinel (new-object)
|
||||
nil->sentinel (fn [x] (if (nil? x) sentinel x))
|
||||
sentinel->nil (fn [x] (if (identical? x sentinel) nil x))]
|
||||
|
||||
(defn reduce-top
|
||||
"Reduces the top `n` items from `coll` of N items into in O(N.logn) time.
|
||||
For comparsion, (take n (sort-by ...)) is O(N.logN)."
|
||||
([n rf init coll] (reduce-top n identity compare rf init coll))
|
||||
([n keyfn rf init coll] (reduce-top n keyfn compare rf init coll))
|
||||
([n keyfn cmp rf init coll]
|
||||
(let [coll-size (count coll)
|
||||
n (long (min coll-size (long n)))]
|
||||
|
||||
(if-not (pos? n)
|
||||
init
|
||||
(let [pq (java.util.PriorityQueue. coll-size
|
||||
(fn [x y] (cmp (keyfn (sentinel->nil x))
|
||||
(keyfn (sentinel->nil y)))))]
|
||||
|
||||
(run! #(.offer pq (nil->sentinel %)) coll)
|
||||
(reduce-n (fn [acc _] (rf acc (sentinel->nil (.poll pq))))
|
||||
init n)))))))
|
||||
(let [always (fn always [?in-str] true)
|
||||
never (fn never [?in-str] false)
|
||||
|
||||
wild-str->?re-pattern
|
||||
(fn [s]
|
||||
(when (str-contains? s "*")
|
||||
(re-pattern
|
||||
(-> (str "^" s "$")
|
||||
(str/replace "." "\\.")
|
||||
(str/replace "*" "(.*)")))))
|
||||
|
||||
compile
|
||||
(fn compile [spec cache?] ; Returns (fn match? [in-str])
|
||||
(cond
|
||||
(#{:any "*" } spec) always
|
||||
(#{:none #{} []} spec) never
|
||||
(re-pattern? spec) (fn [in-str] (re-find spec in-str))
|
||||
(string? spec)
|
||||
(cond
|
||||
;; Ambiguous: "," meant as splitter or literal? Prefer coll.
|
||||
;; (str-contains? spec ",") (recur (mapv str/trim (str/split spec #",")) cache?)
|
||||
:if-let [re-pattern (wild-str->?re-pattern spec)]
|
||||
|
||||
(recur re-pattern cache?)
|
||||
:else (fn [in-str] (= in-str spec)))
|
||||
|
||||
(or (vector? spec) (set? spec))
|
||||
(cond
|
||||
;; (empty? spec) never
|
||||
((set spec) "*") always
|
||||
(= (count spec) 1) (recur (first spec) cache?)
|
||||
:else
|
||||
(let [[fixed-strs re-patterns]
|
||||
(reduce
|
||||
(fn [[fixed-strs re-patterns] spec]
|
||||
(if-let [re-pattern (if (re-pattern? spec) spec (wild-str->?re-pattern spec))]
|
||||
[ fixed-strs (conj re-patterns re-pattern)]
|
||||
[(conj fixed-strs spec) re-patterns ]))
|
||||
[#{} []]
|
||||
spec)
|
||||
|
||||
fx-match (not-empty fixed-strs) ; #{"foo" "bar"}, etc.
|
||||
re-match
|
||||
(when-let [re-patterns (not-empty re-patterns)] ; ["foo.*", "bar.*"], etc.
|
||||
(let [f (fn [in-str] (rsome #(re-find % in-str) re-patterns))]
|
||||
(if cache? (fmemoize f) f)))]
|
||||
|
||||
(cond!
|
||||
(and fx-match re-match) (fn [in-str] (or (fx-match in-str) (re-match in-str)))
|
||||
fx-match fx-match
|
||||
re-match re-match)))
|
||||
|
||||
:else
|
||||
(throw
|
||||
(ex-info "Unexpected compile spec type"
|
||||
{:given spec :type (type spec)}))))]
|
||||
|
||||
(defn compile-str-filter
|
||||
"Compiles given spec and returns a fast (fn conform? [?in-str]).
|
||||
|
||||
Spec may be:
|
||||
- A regex pattern. Will conform on match.
|
||||
- A string, in which any \"*\"s will act as wildcards (#\".*\").
|
||||
Will conform on match.
|
||||
|
||||
- A vector or set of regex patterns or strings.
|
||||
Will conform on ANY match.
|
||||
If you need literal \"*\"s, use an explicit regex pattern instead.
|
||||
|
||||
- {:allow <allow-spec> :deny <deny-spec> :cache? <bool>}.
|
||||
Will conform iff allow-spec matches AND deny-spec does NOT.
|
||||
|
||||
Input may be: namespace strings, class names, etc.
|
||||
Useful as string allowlist (whitelist) and/or denylist (blacklist).
|
||||
|
||||
Spec examples:
|
||||
#{}, \"*\", \"foo.bar\", \"foo.bar.*\", #{\"foo\" \"bar.*\"},
|
||||
{:allow #{\"foo\" \"bar.*\"} :deny #{\"foo.*.bar.*\"}}"
|
||||
|
||||
[spec]
|
||||
(if-not (map? spec)
|
||||
(recur {:allow spec :deny nil})
|
||||
(let [cache? (get spec :cache?)
|
||||
allow-spec (or (get spec :allow) (get spec :whitelist))
|
||||
deny-spec (or (get spec :deny) (get spec :blacklist))
|
||||
|
||||
allow (when-let [as allow-spec] (compile as cache?))
|
||||
deny (when-let [ds deny-spec] (compile ds cache?))]
|
||||
|
||||
(cond
|
||||
(= deny always) never
|
||||
(= allow never) never
|
||||
|
||||
(and allow deny)
|
||||
(fn [?in-str]
|
||||
(let [in-str (str ?in-str)]
|
||||
(if (allow in-str)
|
||||
(if (deny in-str)
|
||||
false
|
||||
true)
|
||||
false)))
|
||||
|
||||
allow (if (= allow always) always (fn [?in-str] (if (allow (str ?in-str)) true false)))
|
||||
deny (if (= deny never) always (fn [?in-str] (if (deny (str ?in-str)) true false)))
|
||||
:else
|
||||
(throw
|
||||
(ex-info "compile-str-filter: `allow-spec` and `deny-spec` cannot both be nil"
|
||||
{:allow-spec allow-spec :deny-spec deny-spec})))))))
|
||||
|
|
@ -4,11 +4,12 @@
|
|||
(:require
|
||||
[clojure.string :as str]
|
||||
[clojure.java.io :as jio]
|
||||
[taoensso.encore :as enc]
|
||||
[taoensso.min-encore :as enc]
|
||||
[taoensso.nippy
|
||||
[utils :as utils]
|
||||
[compression :as compression]
|
||||
[encryption :as encryption]])
|
||||
[encryption :as encryption]]
|
||||
[taoensso.truss :as truss])
|
||||
|
||||
(:import
|
||||
[java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream
|
||||
|
|
@ -24,10 +25,6 @@
|
|||
PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList
|
||||
LazySeq IRecord ISeq IType]))
|
||||
|
||||
(if (vector? enc/encore-version)
|
||||
(enc/assert-min-encore-version [2 126 2])
|
||||
(enc/assert-min-encore-version 2.126))
|
||||
|
||||
(comment
|
||||
(set! *unchecked-math* :warn-on-boxed)
|
||||
(set! *unchecked-math* false)
|
||||
|
|
@ -344,7 +341,7 @@
|
|||
(if (allow-and-record? s) s (split-class-names>set s)))]
|
||||
|
||||
(if (and allowlist-base allowlist-add)
|
||||
(into (enc/have set? allowlist-base) allowlist-add)
|
||||
(into (truss/have set? allowlist-base) allowlist-add)
|
||||
(do allowlist-base)))))
|
||||
|
||||
(let [doc
|
||||
|
|
@ -2016,7 +2013,7 @@
|
|||
(defn inspect-ba "Alpha - subject to change"
|
||||
([ba ] (inspect-ba ba nil))
|
||||
([ba thaw-opts]
|
||||
(when (enc/bytes? ba)
|
||||
(when (bytes? ba)
|
||||
(let [[first2bytes nextbytes] (enc/ba-split ba 2)
|
||||
?known-wrapper
|
||||
(enc/cond
|
||||
|
|
@ -2090,12 +2087,5 @@
|
|||
(comment
|
||||
(freeze-to-file "foo.npy" "hello, world!")
|
||||
(thaw-from-file "foo.npy")
|
||||
(thaw-from-file (jio/resource "foo.npy")))
|
||||
|
||||
;;;; Deprecated
|
||||
|
||||
(enc/deprecated
|
||||
(def 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 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)))
|
||||
(thaw-from-file (jio/resource "foo.npy"))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
(ns taoensso.nippy.compression
|
||||
(:require [taoensso.encore :as enc])
|
||||
(:import [java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream
|
||||
DataOutputStream]))
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
"Low-level crypto utils.
|
||||
Private & alpha, very likely to change!"
|
||||
(:refer-clojure :exclude [rand-nth])
|
||||
(:require [taoensso.encore :as enc]))
|
||||
(:require [taoensso.min-encore :as enc]
|
||||
[taoensso.truss :as truss]))
|
||||
|
||||
;; Note that AES128 may be preferable to AES256 due to known attack
|
||||
;; vectors specific to AES256, Ref. https://goo.gl/qU4CCV
|
||||
|
|
@ -33,10 +34,7 @@
|
|||
(defn sha512-md ^java.security.MessageDigest [] (.get ^ThreadLocal sha512-md*))
|
||||
(defn sha256-ba ^bytes [ba] (.digest (sha256-md) ba))
|
||||
(defn sha512-ba ^bytes [ba] (.digest (sha512-md) ba))
|
||||
|
||||
(enc/compile-if clojure.lang.Murmur3
|
||||
(defn murmur3 [^String s] (clojure.lang.Murmur3/hashUnencodedChars s))
|
||||
nil)
|
||||
(defn murmur3 [^String s] (clojure.lang.Murmur3/hashUnencodedChars s))
|
||||
|
||||
;;;; Key derivation (salt+password -> key / hash)
|
||||
;; (fn [salt-ba utf8]) -> bytes
|
||||
|
|
@ -45,7 +43,7 @@
|
|||
(defn take-ba ^bytes [n ^bytes ba] (java.util.Arrays/copyOf ba ^int n)) ; Pads if ba too small
|
||||
(defn utf8->ba ^bytes [^String s] (.getBytes s "UTF-8"))
|
||||
(defn- add-salt ^bytes [?salt-ba ba] (if ?salt-ba (enc/ba-concat ?salt-ba ba) ba))
|
||||
(defn pwd-as-ba ^bytes [utf8-or-ba] (if (string? utf8-or-ba) (utf8->ba utf8-or-ba) (enc/have enc/bytes? utf8-or-ba)))
|
||||
(defn pwd-as-ba ^bytes [utf8-or-ba] (if (string? utf8-or-ba) (utf8->ba utf8-or-ba) (truss/have bytes? utf8-or-ba)))
|
||||
|
||||
(comment (seq (pwd-as-ba "foo")))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
(ns taoensso.nippy.encryption
|
||||
"Simple no-nonsense crypto with reasonable defaults"
|
||||
(:require
|
||||
[taoensso.encore :as enc]
|
||||
[taoensso.min-encore :as enc]
|
||||
[taoensso.nippy.crypto :as crypto]))
|
||||
|
||||
(def standard-header-ids
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(ns taoensso.nippy.utils
|
||||
(:require [clojure.string :as str]
|
||||
[taoensso.encore :as enc])
|
||||
[taoensso.min-encore :as enc])
|
||||
(:import [java.io ByteArrayInputStream ByteArrayOutputStream Serializable
|
||||
ObjectOutputStream ObjectInputStream]))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue