mirror of
https://github.com/penpot/penpot.git
synced 2025-12-23 22:48:40 -05:00
This upgrade also includes complete elimination of use spec from the backend codebase, completing the long running migration to fully use malli for validation and decoding.
377 lines
13 KiB
Clojure
377 lines
13 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC
|
|
|
|
(ns app.redis
|
|
"The msgbus abstraction implemented using redis as underlying backend."
|
|
(:refer-clojure :exclude [eval])
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.logging :as l]
|
|
[app.common.schema :as sm]
|
|
[app.metrics :as mtx]
|
|
[app.redis.script :as-alias rscript]
|
|
[app.util.cache :as cache]
|
|
[app.util.time :as dt]
|
|
[app.worker :as-alias wrk]
|
|
[clojure.core :as c]
|
|
[clojure.java.io :as io]
|
|
[cuerdas.core :as str]
|
|
[integrant.core :as ig]
|
|
[promesa.core :as p]
|
|
[promesa.exec :as px])
|
|
(:import
|
|
clojure.lang.MapEntry
|
|
io.lettuce.core.KeyValue
|
|
io.lettuce.core.RedisClient
|
|
io.lettuce.core.RedisCommandInterruptedException
|
|
io.lettuce.core.RedisCommandTimeoutException
|
|
io.lettuce.core.RedisException
|
|
io.lettuce.core.RedisURI
|
|
io.lettuce.core.ScriptOutputType
|
|
io.lettuce.core.api.StatefulConnection
|
|
io.lettuce.core.api.StatefulRedisConnection
|
|
io.lettuce.core.api.async.RedisAsyncCommands
|
|
io.lettuce.core.api.async.RedisScriptingAsyncCommands
|
|
io.lettuce.core.api.sync.RedisCommands
|
|
io.lettuce.core.codec.ByteArrayCodec
|
|
io.lettuce.core.codec.RedisCodec
|
|
io.lettuce.core.codec.StringCodec
|
|
io.lettuce.core.pubsub.RedisPubSubListener
|
|
io.lettuce.core.pubsub.StatefulRedisPubSubConnection
|
|
io.lettuce.core.pubsub.api.sync.RedisPubSubCommands
|
|
io.lettuce.core.resource.ClientResources
|
|
io.lettuce.core.resource.DefaultClientResources
|
|
io.netty.util.HashedWheelTimer
|
|
io.netty.util.Timer
|
|
java.lang.AutoCloseable
|
|
java.time.Duration))
|
|
|
|
(set! *warn-on-reflection* true)
|
|
|
|
(declare ^:private initialize-resources)
|
|
(declare ^:private shutdown-resources)
|
|
(declare ^:private impl-eval)
|
|
|
|
(defprotocol IRedis
|
|
(-connect [_ options])
|
|
(-get-or-connect [_ key options]))
|
|
|
|
(defprotocol IConnection
|
|
(publish [_ topic message])
|
|
(rpush [_ key payload])
|
|
(blpop [_ timeout keys])
|
|
(eval [_ script]))
|
|
|
|
(defprotocol IPubSubConnection
|
|
(add-listener [_ listener])
|
|
(subscribe [_ topics])
|
|
(unsubscribe [_ topics]))
|
|
|
|
(def default-codec
|
|
(RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
|
|
|
|
(def string-codec
|
|
(RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
|
|
|
|
(sm/register!
|
|
{:type ::connection
|
|
:pred #(satisfies? IConnection %)
|
|
:type-properties
|
|
{:title "connection"
|
|
:description "redis connection instance"}})
|
|
|
|
(sm/register!
|
|
{:type ::pubsub-connection
|
|
:pred #(satisfies? IPubSubConnection %)
|
|
:type-properties
|
|
{:title "connection"
|
|
:description "redis connection instance"}})
|
|
|
|
(defn redis?
|
|
[o]
|
|
(satisfies? IRedis o))
|
|
|
|
(sm/register!
|
|
{:type ::redis
|
|
:pred redis?})
|
|
|
|
(def ^:private schema:script
|
|
[:map {:title "script"}
|
|
[::rscript/name qualified-keyword?]
|
|
[::rscript/path ::sm/text]
|
|
[::rscript/keys {:optional true} [:vector :any]]
|
|
[::rscript/vals {:optional true} [:vector :any]]])
|
|
|
|
(def valid-script?
|
|
(sm/lazy-validator schema:script))
|
|
|
|
(defmethod ig/expand-key ::redis
|
|
[k v]
|
|
(let [cpus (px/get-available-processors)
|
|
threads (max 1 (int (* cpus 0.2)))]
|
|
{k (-> (d/without-nils v)
|
|
(assoc ::timeout (dt/duration "10s"))
|
|
(assoc ::io-threads (max 3 threads))
|
|
(assoc ::worker-threads (max 3 threads)))}))
|
|
|
|
(def ^:private schema:redis-params
|
|
[:map {:title "redis-params"}
|
|
::wrk/executor
|
|
::mtx/metrics
|
|
[::uri ::sm/uri]
|
|
[::worker-threads ::sm/int]
|
|
[::io-threads ::sm/int]
|
|
[::timeout ::dt/duration]])
|
|
|
|
(defmethod ig/assert-key ::redis
|
|
[_ params]
|
|
(assert (sm/check schema:redis-params params)))
|
|
|
|
(defmethod ig/init-key ::redis
|
|
[_ params]
|
|
(initialize-resources params))
|
|
|
|
(defmethod ig/halt-key! ::redis
|
|
[_ instance]
|
|
(d/close! instance))
|
|
|
|
(defn- initialize-resources
|
|
"Initialize redis connection resources"
|
|
[{:keys [::uri ::io-threads ::worker-threads ::wrk/executor ::mtx/metrics] :as params}]
|
|
|
|
(l/inf :hint "initialize redis resources"
|
|
:uri (str uri)
|
|
:io-threads io-threads
|
|
:worker-threads worker-threads)
|
|
|
|
(let [timer (HashedWheelTimer.)
|
|
resources (.. (DefaultClientResources/builder)
|
|
(ioThreadPoolSize ^long io-threads)
|
|
(computationThreadPoolSize ^long worker-threads)
|
|
(timer ^Timer timer)
|
|
(build))
|
|
|
|
redis-uri (RedisURI/create ^String (str uri))
|
|
|
|
shutdown (fn [client conn]
|
|
(ex/ignoring (.close ^StatefulConnection conn))
|
|
(ex/ignoring (.close ^RedisClient client))
|
|
(l/trc :hint "disconnect" :hid (hash client)))
|
|
|
|
on-remove (fn [key val cause]
|
|
(l/trace :hint "evict connection (cache)" :key key :reason cause)
|
|
(some-> val d/close!))
|
|
|
|
cache (cache/create :executor executor
|
|
:on-remove on-remove
|
|
:keepalive "5m")]
|
|
(reify
|
|
java.lang.AutoCloseable
|
|
(close [_]
|
|
(ex/ignoring (cache/invalidate! cache))
|
|
(ex/ignoring (.shutdown ^ClientResources resources))
|
|
(ex/ignoring (.stop ^Timer timer)))
|
|
|
|
IRedis
|
|
(-get-or-connect [this key options]
|
|
(let [create (fn [_] (-connect this options))]
|
|
(cache/get cache key create)))
|
|
|
|
(-connect [_ options]
|
|
(let [timeout (or (:timeout options) (::timeout params))
|
|
codec (get options :codec default-codec)
|
|
type (get options :type :default)
|
|
client (RedisClient/create ^ClientResources resources
|
|
^RedisURI redis-uri)]
|
|
|
|
(l/trc :hint "connect" :hid (hash client))
|
|
(if (= type :pubsub)
|
|
(let [conn (.connectPubSub ^RedisClient client
|
|
^RedisCodec codec)]
|
|
(.setTimeout ^StatefulConnection conn
|
|
^Duration timeout)
|
|
(reify
|
|
IPubSubConnection
|
|
(add-listener [_ listener]
|
|
(assert (instance? RedisPubSubListener listener) "expected listener instance")
|
|
(.addListener ^StatefulRedisPubSubConnection conn
|
|
^RedisPubSubListener listener))
|
|
|
|
(subscribe [_ topics]
|
|
(try
|
|
(let [topics (into-array String (map str topics))
|
|
cmd (.sync ^StatefulRedisPubSubConnection conn)]
|
|
(.subscribe ^RedisPubSubCommands cmd topics))
|
|
(catch RedisCommandInterruptedException cause
|
|
(throw (InterruptedException. (ex-message cause))))))
|
|
|
|
(unsubscribe [_ topics]
|
|
(try
|
|
(let [topics (into-array String (map str topics))
|
|
cmd (.sync ^StatefulRedisPubSubConnection conn)]
|
|
(.unsubscribe ^RedisPubSubCommands cmd topics))
|
|
(catch RedisCommandInterruptedException cause
|
|
(throw (InterruptedException. (ex-message cause))))))
|
|
|
|
|
|
AutoCloseable
|
|
(close [_] (shutdown client conn))))
|
|
|
|
(let [conn (.connect ^RedisClient client ^RedisCodec codec)]
|
|
(.setTimeout ^StatefulConnection conn ^Duration timeout)
|
|
(reify
|
|
IConnection
|
|
(publish [_ topic message]
|
|
(assert (string? topic) "expected topic to be string")
|
|
(assert (bytes? message) "expected message to be a byte array")
|
|
|
|
(let [pcomm (.async ^StatefulRedisConnection conn)]
|
|
(.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
|
|
|
|
(rpush [_ key payload]
|
|
(assert (or (and (vector? payload)
|
|
(every? bytes? payload))
|
|
(bytes? payload)))
|
|
(try
|
|
(let [cmd (.sync ^StatefulRedisConnection conn)
|
|
data (if (vector? payload) payload [payload])
|
|
vals (make-array (. Class (forName "[B")) (count data))]
|
|
|
|
(loop [i 0 xs (seq data)]
|
|
(when xs
|
|
(aset ^"[[B" vals i ^bytes (first xs))
|
|
(recur (inc i) (next xs))))
|
|
|
|
(.rpush ^RedisCommands cmd
|
|
^String key
|
|
^"[[B" vals))
|
|
|
|
(catch RedisCommandInterruptedException cause
|
|
(throw (InterruptedException. (ex-message cause))))))
|
|
|
|
(blpop [_ timeout keys]
|
|
(try
|
|
(let [keys (into-array Object (map str keys))
|
|
cmd (.sync ^StatefulRedisConnection conn)
|
|
timeout (/ (double (inst-ms timeout)) 1000.0)]
|
|
(when-let [res (.blpop ^RedisCommands cmd
|
|
^double timeout
|
|
^"[Ljava.lang.String;" keys)]
|
|
(MapEntry/create
|
|
(.getKey ^KeyValue res)
|
|
(.getValue ^KeyValue res))))
|
|
(catch RedisCommandInterruptedException cause
|
|
(throw (InterruptedException. (ex-message cause))))))
|
|
|
|
(eval [_ script]
|
|
(assert (valid-script? script) "expected valid script")
|
|
(impl-eval conn metrics script))
|
|
|
|
AutoCloseable
|
|
(close [_] (shutdown client conn))))))))))
|
|
|
|
(defn connect
|
|
[instance & {:as opts}]
|
|
(assert (satisfies? IRedis instance) "expected valid redis instance")
|
|
(-connect instance opts))
|
|
|
|
(defn get-or-connect
|
|
[instance key & {:as opts}]
|
|
(assert (satisfies? IRedis instance) "expected valid redis instance")
|
|
(-get-or-connect instance key opts))
|
|
|
|
(defn pubsub-listener
|
|
[& {:keys [on-message on-subscribe on-unsubscribe]}]
|
|
(reify RedisPubSubListener
|
|
(message [_ pattern topic message]
|
|
(when on-message
|
|
(on-message pattern topic message)))
|
|
|
|
(message [_ topic message]
|
|
(when on-message
|
|
(on-message nil topic message)))
|
|
|
|
(psubscribed [_ pattern count]
|
|
(when on-subscribe
|
|
(on-subscribe pattern nil count)))
|
|
|
|
(punsubscribed [_ pattern count]
|
|
(when on-unsubscribe
|
|
(on-unsubscribe pattern nil count)))
|
|
|
|
(subscribed [_ topic count]
|
|
(when on-subscribe
|
|
(on-subscribe nil topic count)))
|
|
|
|
(unsubscribed [_ topic count]
|
|
(when on-unsubscribe
|
|
(on-unsubscribe nil topic count)))))
|
|
|
|
(def ^:private scripts-cache (atom {}))
|
|
|
|
(defn- impl-eval
|
|
[^StatefulRedisConnection connection metrics script]
|
|
(let [cmd (.async ^StatefulRedisConnection connection)
|
|
keys (into-array String (map str (::rscript/keys script)))
|
|
vals (into-array String (map str (::rscript/vals script)))
|
|
sname (::rscript/name script)]
|
|
|
|
(letfn [(on-error [cause]
|
|
(if (instance? io.lettuce.core.RedisNoScriptException cause)
|
|
(do
|
|
(l/error :hint "no script found" :name sname :cause cause)
|
|
(->> (load-script)
|
|
(p/mcat eval-script)))
|
|
(if-let [on-error (::rscript/on-error script)]
|
|
(on-error cause)
|
|
(p/rejected cause))))
|
|
|
|
(eval-script [sha]
|
|
(let [tpoint (dt/tpoint)]
|
|
(->> (.evalsha ^RedisScriptingAsyncCommands cmd
|
|
^String sha
|
|
^ScriptOutputType ScriptOutputType/MULTI
|
|
^"[Ljava.lang.String;" keys
|
|
^"[Ljava.lang.String;" vals)
|
|
(p/fmap (fn [result]
|
|
(let [elapsed (tpoint)]
|
|
(mtx/run! metrics {:id :redis-eval-timing
|
|
:labels [(name sname)]
|
|
:val (inst-ms elapsed)})
|
|
(l/trace :hint "eval script"
|
|
:name (name sname)
|
|
:sha sha
|
|
:params (str/join "," (::rscript/vals script))
|
|
:elapsed (dt/format-duration elapsed))
|
|
result)))
|
|
(p/merr on-error))))
|
|
|
|
(read-script []
|
|
(-> script ::rscript/path io/resource slurp))
|
|
|
|
(load-script []
|
|
(l/trace :hint "load script" :name sname)
|
|
(->> (.scriptLoad ^RedisScriptingAsyncCommands cmd
|
|
^String (read-script))
|
|
(p/fmap (fn [sha]
|
|
(swap! scripts-cache assoc sname sha)
|
|
sha))))]
|
|
|
|
(p/await!
|
|
(if-let [sha (get @scripts-cache sname)]
|
|
(eval-script sha)
|
|
(->> (load-script)
|
|
(p/mapcat eval-script)))))))
|
|
|
|
(defn timeout-exception?
|
|
[cause]
|
|
(instance? RedisCommandTimeoutException cause))
|
|
|
|
(defn exception?
|
|
[cause]
|
|
(instance? RedisException cause))
|