diff --git a/CHANGELOG.md b/CHANGELOG.md index 1749566..1208946 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,9 +26,9 @@ And as always **please report any unexpected problems** - thank you! 🙏 > **Dep**: Carmine is [on Clojars](https://clojars.org/com.taoensso/carmine/versions/3.4.0). > **Versioning**: Carmine uses [Break Versioning](https://www.taoensso.com/break-versioning). -This is a **maintenance release** that should be **non-breaking** for most users. +This is a **security and maintenance release** that should be **non-breaking** for most users. -The release **updates Carmine's Nippy version** from `v3.3.0` to `v3.4.2`. Please review the [relevant Nippy release info](https://github.com/taoensso/nippy/releases/tag/v3.4.2), and **ensure adequate testing** in your environment before updating production data. +⚠️ It addresses a [**security vulnerability**](https://github.com/taoensso/nippy/security/advisories/GHSA-vw78-267v-588h) in [Nippy](https://www.taoensso.com/nippy)'s upstream compression library and is **recommended for all existing users**. Please review the [relevant Nippy release info](https://github.com/taoensso/nippy/releases/tag/v3.4.2), and **ensure adequate testing** in your environment before updating production data. And as always **please report any unexpected problems** - thank you! 🙏 diff --git a/README.md b/README.md index 165ab8b..01ababe 100644 --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ Carmine is a mature Redis client for Clojure that offers an idiomatic Clojure AP ## Latest release/s -- `2024-05-30` `v3.4.1`: [release info](../../releases/tag/v3.4.1) +- `2024-05-30` `v3.4.1`: [release info](../../releases/tag/v3.4.1) (⚠️ v3.4.0+ contains [**security fix**](https://github.com/taoensso/nippy/security/advisories/GHSA-vw78-267v-588h)) [![Main tests][Main tests SVG]][Main tests URL] [![Graal tests][Graal tests SVG]][Graal tests URL] diff --git a/carmine-v4.org b/carmine-v4.org new file mode 100644 index 0000000..bc8c61d --- /dev/null +++ b/carmine-v4.org @@ -0,0 +1,71 @@ +#+TITLE: Title +#+STARTUP: indent overview hidestars +#+TAGS: { Cost: c1(1) c2(2) c3(3) c4(4) c5(5) } +#+TAGS: nb(n) urgent(u) + +* Next +** Re-eval choice to switch away from KeyedObjectPool +** Review arch needs for Cluster, esp. re: conns + +** Add SSB stats to pooled manager (borrow time, etc.)? +** Add SSB stats to Sentinel? +** Common & core util to parse-?marked-ba -> [ ] +** Some way to implement a parser over >1 replies? +E.g. fetch two sets, and parser to merge -> single reply + +* Later +** New Pub/Sub API? (note RESP2 vs RESP3 differences) +Pub/Sub + Sentinel integration +psubscribe* to Sentinel server +check for `switch-master` channel name +"switch-master" + +** Implement Cluster (enough user demand?) +** Use Telemere (shell API?) + +* Polish +** Print methods, toString content, etc. +** Check all errors: eids, messages, data, cbids +** Check all dynamic bindings and sys-vals, ensure accessible +** Document `*default-conn-opts*`, incl. cbs +** Document `*default-sentinel-opts*`, incl. cbs +** Complete (esp. high-level / integration) tests +** Review all config, docstring, privacy, etc. +** Grep for TODOs + +* Refactor commands +** Add modules support +** Support custom (e.g. newer) commands.json or edn +** Refactor helpers API, etc. +** Modern Tundra? +** Further MQ improvements? + +* Release +** v4 upgrade/migration plan +** v4 wiki with changes, migration, new features, examples, etc. +** First public alpha + +* CHANGELOG +** [new] Full RESP3 support, incl. streaming, etc. +*** Enabled by default, requires Redis >= v6 (2020-04-30). +** [new] Full Redis Sentinel support - incl. auto failover and read replicas. +** [mod] Hugely improved connections API, incl. improved: +*** Flexibility +*** Docs +*** Usability (e.g. opts validation, hard shutdowns, closing managed conns, etc.). +*** Transparency (deref stats, cbs, timings for profiling, etc.). +**** Derefs: Conns, ConnManagers, SentinelSpecs. +*** Protocols for extension by advanced users. +*** Full integration with Sentinel, incl.: +**** Auto invalidation of pool conns on master changes. +**** Auto verification of addresses on pool borrows. +*** [new] Common conn utils are now aliased in core Carmine ns for convenience. +*** [new] Improved pool efficiency, incl. smarter sub-pool keying. +*** [mod] Improved parsing API, incl.: +**** General simplifications. +**** Aggregate parsers, with xform support. +*** [new] *auto-serialize?*, *auto-deserialize?* +*** [new] Greatly improved `skip-replies` performance +*** [mod] Simplified parsers API +*** [new] Improvements to docs, error messages, debug data, etc. +*** [new] New Wiki with further documentation and examples. diff --git a/project.clj b/project.clj index bc8a58a..b4809f7 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject com.taoensso/carmine "3.4.1" +(defproject com.taoensso/carmine "3.5.0-SNAPSHOT" :author "Peter Taoussanis " :description "Redis client + message queue for Clojure" :url "https://github.com/taoensso/carmine" @@ -56,11 +56,16 @@ {:language #{:clojure #_:clojurescript} :base-language :clojure}}} + :test-selectors + {:v3 (fn [{:keys [ns]} & _] (.startsWith (str ns) "taoensso.carmine.")) + :v4 (fn [{:keys [ns]} & _] (.startsWith (str ns) "taoensso.carmine-v4."))} + :aliases {"start-dev" ["with-profile" "+dev" "repl" ":headless"] ;; "build-once" ["do" ["clean"] ["cljsbuild" "once"]] "deploy-lib" ["do" #_["build-once"] ["deploy" "clojars"] ["install"]] + "test-v4" ["with-profile" "+c1.12:+c1.11:+c1.10:+c1.9" "test" ":v4"] "test-clj" ["with-profile" "+c1.12:+c1.11:+c1.10:+c1.9" "test"] ;; "test-cljs" ["with-profile" "+c1.12" "cljsbuild" "test"] "test-all" ["do" ["clean"] ["test-clj"] #_["test-cljs"]]}) diff --git a/src/taoensso/carmine/locks.clj b/src/taoensso/carmine/locks.clj index fa734c3..f1643a6 100644 --- a/src/taoensso/carmine/locks.clj +++ b/src/taoensso/carmine/locks.clj @@ -15,24 +15,15 @@ (defn acquire-lock "Attempts to acquire a distributed lock, returning an owner UUID iff successful." - ;; TODO Waiting on http://goo.gl/YemR7 for simpler (non-Lua) solution [conn-opts lock-name timeout-ms wait-ms] (let [max-udt (+ wait-ms (System/currentTimeMillis)) uuid (str (java.util.UUID/randomUUID))] (wcar conn-opts ; Hold one connection for all attempts (loop [] (when (> max-udt (System/currentTimeMillis)) - (if (-> (car/lua - "if redis.call('setnx', _:lkey, _:uuid) == 1 then - redis.call('pexpire', _:lkey, _:timeout-ms); - return 1; - else - return 0; - end" - {:lkey (lkey lock-name)} - {:uuid uuid - :timeout-ms timeout-ms}) - car/with-replies car/as-bool) + (if (-> (car/set (lkey lock-name) uuid "nx" "px" timeout-ms) + (car/with-replies) + (= "OK")) (car/return uuid) (do (Thread/sleep 1) (recur)))))))) diff --git a/src/taoensso/carmine/message_queue.clj b/src/taoensso/carmine/message_queue.clj index 195b09b..675ec69 100644 --- a/src/taoensso/carmine/message_queue.clj +++ b/src/taoensso/carmine/message_queue.clj @@ -619,11 +619,15 @@ java.io.Closeable (close [this] (stop this)) Object - (toString [this] ; "CarmineMessageQueueWorker[nthreads=1w+1h, running]" - (str "CarmineMessageQueueWorker[qname=" qname ", nthreads=" + (toString [this] + ;; "CarmineMessageQueueWorker[qname=foo nthreads=1w+1h running 0x7b9f6831]" + (str "CarmineMessageQueueWorker[" + "qname=" qname " " + "nthreads=" (get worker-opts :nthreads-worker) "w+" - (get worker-opts :nthreads-handler) "h, " - (if @running?_ "running" "shut down") "]")) + (get worker-opts :nthreads-handler) "h " + (if @running?_ "running" "shut down") " " + (enc/ident-hex-str this) "]")) clojure.lang.IDeref (deref [this] diff --git a/src/taoensso/carmine_v4.clj b/src/taoensso/carmine_v4.clj new file mode 100644 index 0000000..af82bba --- /dev/null +++ b/src/taoensso/carmine_v4.clj @@ -0,0 +1,316 @@ +(ns ^:no-doc taoensso.carmine-v4 + "Experimental modern Clojure Redis client prototype. + Still private, not yet intended for public use!" + {:author "Peter Taoussanis (@ptaoussanis)"} + (:require + [taoensso.encore :as enc] + [taoensso.carmine :as v3-core] + [taoensso.carmine + [connections :as v3-conns] + [protocol :as v3-protocol] + [commands :as v3-cmds]] + + [taoensso.carmine-v4.resp.common :as com] + [taoensso.carmine-v4.resp.read :as read] + [taoensso.carmine-v4.resp.write :as write] + [taoensso.carmine-v4.resp :as resp] + ;; + [taoensso.carmine-v4.utils :as utils] + [taoensso.carmine-v4.opts :as opts] + [taoensso.carmine-v4.conns :as conns] + [taoensso.carmine-v4.sentinel :as sentinel] + [taoensso.carmine-v4.cluster :as cluster])) + +(enc/assert-min-encore-version [3 112 0]) + +(comment (remove-ns 'taoensso.carmine-v4)) + +;;;; Aliases + +(enc/defaliases + enc/get-env + + ;;; Read opts + com/skip-replies + com/normal-replies + com/as-bytes + com/as-thawed + com/natural-reads + + ;;; Reply parsing + com/reply-error? + com/unparsed + com/parse + com/parse-aggregates + com/completing-rf + ;; + com/as-?long + com/as-?double + com/as-?kw + ;; + com/as-long + com/as-double + com/as-kw + + ;;; Write wrapping + write/to-bytes + write/to-frozen + + ;;; RESP3 + resp/rcall + resp/rcall* + resp/rcalls + resp/rcalls* + resp/local-echo + resp/local-echos + resp/local-echos* + + ;;; Connections + #_conns/conn? + #_conns/conn-ready? + #_conns/conn-close! + ;; + sentinel/sentinel-spec + sentinel/sentinel-spec? + ;; + conns/conn-manager? + conns/conn-manager-unpooled + conns/conn-manager-pooled + {:alias conn-manager-ready? :src conns/mgr-ready?} + {:alias conn-manager-clear! :src conns/mgr-clear!} + {:alias conn-manager-close! :src conns/mgr-close!} + + ;;; Cluster + cluster/cluster-key) + +;;;; Config + +(def default-conn-opts + "TODO Docstring incl. env config." + (let [from-env (enc/get-env {:as :edn} :taoensso.carmine.default-conn-opts) + base + {:server ["127.0.0.1" 6379] + #_{:host "127.0.0.1" :port "6379"} + #_{:master-name "my-master" + :sentinel-spec my-spec + :sentinel-opts {}} + + :cbs {:on-conn-close nil, :on-conn-error nil} + :buffer-opts {:init-size-in 8192, :init-size-out 8192} + :socket-opts {:ssl false, :connect-timeout-ms 400, :read-timeout-ms nil + :ready-timeout-ms 200} + :init + {;; :commands [["HELLO" 3 "AUTH" "default" "my-password" "SETNAME" "client-name"] + ;; ["auth" "default" "my-password"]] + :resp3? true + :auth {:username "default" :password nil} + ;; :client-name "carmine" + ;; :select-db 5 + }}] + + (enc/nested-merge base from-env))) + +(def default-pool-opts + "TODO Docstring incl. env config." + (let [from-env (enc/get-env {:as :edn} :taoensso.carmine.default-pool-opts) + base + {:test-on-create? true + :test-while-idle? true + :test-on-borrow? true + :test-on-return? false + :num-tests-per-eviction-run -1 + :min-evictable-idle-time-ms 60000 + :time-between-eviction-runs-ms 30000 + :max-total 16 + :max-idle 16}] + + (enc/nested-merge base from-env))) + +(def default-sentinel-opts + "TODO Docstring incl. env config." + (let [from-env (enc/get-env {:as :edn} :taoensso.carmine.default-sentinel-opts) + base + {:cbs + {:on-resolve-success nil + :on-resolve-error nil + :on-changed-master nil + :on-changed-replicas nil + :on-changed-sentinels nil} + + :update-sentinels? true + :update-replicas? false + :prefer-read-replica? false + + :retry-delay-ms 250 + :resolve-timeout-ms 2000 + :clear-timeout-ms 10000 + + :conn-opts + {:cbs {:on-conn-close nil, :on-conn-error nil} + :buffer-opts {:init-size-in 512, :init-size-out 256} + :socket-opts {:ssl false, :connect-timeout-ms 200, :read-timeout-ms 200 + :ready-timeout-ms 200}}}] + + (enc/nested-merge base from-env))) + +;;;; + +(def ^:dynamic *auto-freeze?* + "TODO Docstring incl. env config. + Should Carmine automatically serialize arguments sent to Redis + that are non-native to Redis? + + Affects non-(string, keyword, simple long/double) types. + + Default is true. If false, an exception will be thrown when trying + to send such arguments. + + See also `*auto-freeze?`*." + (enc/get-env {:as :bool, :default true} + :taoensso.carmine.auto-freeze)) + +(def ^:dynamic *auto-thaw?* + "TODO Docstring incl. env config. + Should Carmine automatically deserialize Redis replies that + contain data previously serialized by `*auto-thaw?*`? + + Affects non-(string, keyword, simple long/double) types. + + Default is true. If false, such replies will by default look like + malformed strings. + TODO: Mention utils, bindings. + + See also `*auto-thaw?`*." + (enc/get-env {:as :bool, :default true} + :taoensso.carmine.auto-thaw)) + +(def ^:dynamic *keywordize-maps?* + "TODO Docstring incl. env config." + true) + +(def ^:dynamic *freeze-opts* + "TODO Docstring incl. env config?" + nil) + +(def ^:dynamic *issue-83-workaround?* + "TODO Docstring incl. env config. + A bug in Carmine v2.6.0 to v2.6.1 (2014-04-01 to 2014-05-01) + caused Nippy blobs to be marked incorrectly (with `ba-bin` instead + of `ba-npy`), Ref. + + This should be kept true (the default) if there's a chance you might + read any data written by Carmine < v2.6.1 (2014-05-01). + + Only relevant if `*auto-thaw?` is true." + (enc/get-env {:as :bool, :default true} + :taoensso.carmine.issue-83-workaround)) + +(def ^:dynamic *conn-cbs* + "Map of any additional callback fns, as in `conn-opts` or `sentinel-opts`. + Useful for REPL/debugging/tests/etc. + + Possible keys: + `:on-conn-close` + `:on-conn-error` + `:on-resolve-success` + `:on-resolve-error` + `:on-changed-master` + `:on-changed-replicas` + `:on-changed-sentinels` + + Values should be unary callback fns of a single data map." + nil) + +;;;; Core API (main entry point to Carmine) + +(def ^:private default-conn-manager + (delay (conns/conn-manager-pooled {:mgr-name :default}))) + +(comment (force default-conn-manager)) + +(defn with-car + "TODO Docstring" + ([conn-mgr body-fn] (with-car conn-mgr nil body-fn)) + ([conn-mgr {:keys [as-vec?] :as reply-opts} body-fn] + (let [{:keys [natural-reads?]} reply-opts] ; Undocumented + (conns/mgr-borrow! (force (or conn-mgr default-conn-manager)) + (fn [conn in out] + (resp/with-replies in out natural-reads? as-vec? + (fn [] (body-fn conn)))))))) + +(defmacro wcar + "TODO Docstring" + {:arglists + '([conn-mgr & body] + [conn-mgr {:keys [as-vec?]} & body])} + + [conn-mgr & body] + (let [[reply-opts body] (resp/parse-body-reply-opts body)] + `(with-car ~conn-mgr ~reply-opts + (fn [~'__wcar-conn] ~@body)))) + +(comment + (let [mgr1 (conns/conn-manager-unpooled {}) + mgr2 (conns/conn-manager-pooled {}) + mgr3 (conns/conn-manager-pooled + {:pool-opts + {:test-on-create? false + :test-on-borrow? false + :test-on-return? false}})] + + (try + (enc/qb 1e3 ; [22.33 97.37 38.87 19.86] + (v3-core/wcar {} (v3-core/ping)) + (with-car mgr1 (fn [conn] (resp/ping))) + (with-car mgr2 (fn [conn] (resp/ping))) + (with-car mgr3 (fn [conn] (resp/ping)))) + + (finally + (doseq [mgr [mgr1 mgr2 mgr3]] + (conns/mgr-close! mgr 5000 nil))))) + + [(wcar nil (resp/rcall "PING")) + (wcar nil (resp/rcall "set" "k1" 3)) + (wcar nil (resp/rcall "get" "k1")) + + (wcar nil (resp/ping)) + (wcar nil {:as-vec? true} (resp/ping)) + (wcar nil :as-vec (resp/ping))]) + +(defmacro with-replies + "TODO Docstring + Expects to be called within the body of `wcar` or `with-car`." + {:arglists '([& body] [{:keys [as-vec?]} & body])} + [& body] + (let [[reply-opts body] (resp/parse-body-reply-opts body) + {:keys [natural-reads? as-vec?]} reply-opts] + `(resp/with-replies ~natural-reads? ~as-vec? + (fn [] ~@body)))) + +;;;; Push API ; TODO + +(defmulti push-handler (fn [state [data-type :as data-vec]] data-type)) +(defmethod push-handler :default [state data-vec] #_(println data-vec) nil) + +(enc/defonce push-agent_ + (delay (agent nil :error-mode :continue))) + +(def ^:dynamic *push-fn* + "TODO Docstring: this and push-handler, etc. + ?(fn [data-vec]) => ?effects. + If provided (non-nil), this fn should never throw." + (fn [data-vec] + (send-off @push-agent_ + (fn [state] + (try + (push-handler state data-vec) + (catch Throwable t + ;; TODO Try publish error message? + )))))) + +;;;; Scratch + +;; TODO For command docstrings +;; As with all Carmine Redis command fns: expects to be called within a `wcar` +;; body, and returns nil. The server's reply to this command will be included +;; in the replies returned by the enclosing `wcar`. diff --git a/src/taoensso/carmine_v4/classes.clj b/src/taoensso/carmine_v4/classes.clj new file mode 100644 index 0000000..7c89555 --- /dev/null +++ b/src/taoensso/carmine_v4/classes.clj @@ -0,0 +1,6 @@ +(ns ^:no-doc taoensso.carmine-v4.classes + "Private ns, implementation detail. + Classes, interfaces, etc. isolated from other code to prevent + identity issues during REPL work.") + +(definterface ReplyError) diff --git a/src/taoensso/carmine_v4/cluster.clj b/src/taoensso/carmine_v4/cluster.clj new file mode 100644 index 0000000..41f903a --- /dev/null +++ b/src/taoensso/carmine_v4/cluster.clj @@ -0,0 +1,261 @@ +(ns ^:no-doc taoensso.carmine-v4.cluster + "Private ns, implementation detail. + Implementation of the Redis Cluster protocol, + Ref. " + (:require + [taoensso.encore :as enc :refer [have have?]] + ;;[taoensso.carmine-v4.utils :as utils] + ;;[taoensso.carmine-v4.conns :as conns] + [taoensso.carmine-v4.resp.common :as com] + ;;[taoensso.carmine-v4.resp :as resp] + ;;[taoensso.carmine-v4.opts :as opts] + ) + + #_ + (:import [java.util.concurrent.atomic AtomicLong])) + +(comment (remove-ns 'taoensso.carmine-v4.cluster)) + +;;;; 1st sketch + +;; Update: might now be best with some sort of +;; dedicated cluster ConnManager that can delegate +;; to shard pools, etc. + +;; Without cluster: +;; - with-car [conn-opts] +;; - get-conn [conn-opts], with-conn +;; - With non-cluster ctx [in out] +;; - Flush any pending reqs to allow nesting +;; - New reqs -> pending reqs +;; - Flush +;; - Write reqs +;; - Read replies + +;; With cluster: +;; - with-car [conn-opts] +;; - With cluster ctx [conn-opts] +;; - Flush any pending reqs to allow nesting +;; - New reqs -> pending reqs +;; - Flush +;; - get-conn [conn-opts], with-conn for each shard +;; - Write reqs +;; - Read replies + +;; [ ] +;; conn-opts to incl {:keys [cluster-spec cluster-opts]} :server +;; - => Can use Sentinel or Cluster, not both +;; - cluster-spec constructor will take initial set of shard addrs +;; - cluster-opts to contain :conn-opts to use when updating state, etc. +;; - Ensure Sentinel conn-opts doesn't include Sentinel or Cluster server x +;; - Ensure Cluster conn-opts doesn't include Sentinel or Cluster server +;; - Ensure :select-db is nil/0 when using Cluster + +;; Slots: +;; - Slot range is divided between different shards (shard-addrs) +;; - Each Req will have optional slot field +;; - Slots can be determined automatically for auto-generated commands: +;; - First arg after command name seems to usu. indicate "key". +;; - If there's any additional keys, their slots would anyway need to agree +;; - `rcall` and co. expect `cluster-key` to be called manually on the appropriate arg + +;; [ ] +;; Stateful ClusterSpec: +;; - shards-state_: sorted map {[ ] {:master :replicas #{s}}} +;; - "Stable" when no ongoing reconfig (how to detect?) +;; - ^:private slot->shard-addr [spec parsed-cluster-opts slot] +;; - Check :prefer-read-replica? in cluster-opts +;; - Returns (or ?random-replica master) +;; - Some slots may not have shard-addr, even after updating state +;; +;; - ^:public update-shards! [spec parsed-cluster-opts async?] +;; - Use locking and/or delay with timeout (fire future on CAS state->updating) +;; - Use :conn-opts in cluster-opts +;; - Use `SENTINEL SHARDS` or `SENTINEL SLOTS` command (support both) +;; +;; - Stats incl.: n-shards, n-reshards, n-moved, n-ask etc. +;; - Cbs incl.: on-changed-shards, on-key-moved, etc. + +;; [ ] +;; Cluster specific flush [conn-opts] implementation: +;; - [1] First partition reqs into n target shards +;; - [1b] Check `cluster-slot` and `supports-cluster?` (must be true or nil) +;; - [2] Acquire conns to n target shards (use wcar conn-opts with injected shard-addr) +;; - [2b] If :prefer-read-replica? in cluster-opts - +;; Call READONLY/READWRITE (skipping replies) +;; - [*] Mention that we _could_ use fp to write & read to each shard simultaneously +;; - [3] Write to all shards +;; - [4] Read replies from all shards +;; - [5] If there's any -MOVED, -ASK, or conn (?) errors: +;; - Ask ClusterSpec to update-shards! (async?) +;; - Retry these reqs +;; - [6] Carefully stitch back replies in correct order +;; - [7] Ensure that nesting works as expected + +;; Details on partitioning scheme (could be pure, data-oriented fn): +;; - Loop through all reqs in order +;; - If req -> slot -> shard-addr, add [req req-idx] to partition for that shard-addr +;; - If req -> nil, add [req req-idx] to last non-nil partition, +;; or buffer until first non-nil partition. +;; - If never any non-nil partition: choose random shard-addr. + +;; Conn pooling: +;; - Pool to operate solely on [host port] servers, injected by slot->addr in flush. +;; - I.e. pool needs no invalidation or kop-key changes. + +;;;; Misc + +;; - Would use Cluster or Sentinel, not both. +;; - Sentinel provides best availability, and some read perf via replicas. +;; - Cluster provides some availability, and read+write perf via sharding. + +;; - Cluster supports all 1-key commands, and >1 key commands iff all keys +;; in same hash slot. +;; - Select command not allowed. +;; - Optional hash tags allow manual control of hash slots. + +;; - Cluster "stable" when no ongoing reconfig (i.e. hash slots being moved) +;; - Each node has unique node-id +;; - Nodes can change host without changing node-id (problematic?) + +;; - Cluster has internal concept of { } +;; - Client should store state like +;; {[ ] {:master :replicas #{s}}}, more +;; +;; - To get cluster topology: +;; - CLUSTER SHARDS (Redis >= v7), +;; - CLUSTER SLOTS (Redis <= v6), deprecated +;; - Client cannot assume that all slots will be accounted for, +;; may need to re-fetch topology or try a random node +;; +;; - Update topology when: +;; - Initially empty +;; - Any command saw a -MOVED error (use locking?) + +;; - Possible Cluster errors: +;; - -MOVED => permanently moved +;; -MOVED 3999 127.0.0.1:6381 ; (3999 = key slot) => try host:port +;; -MOVED 3999 :6380 ; => unknown endpoint, try :port +;; +;; - On redirection error: +;; - Either update cache for specific slot, or whole topology +;; - Prefer whole topology (since one move usu. => more) +;; +;; - ASK => +;; - Send this query (ONCE) to specified endpoint, don't update cache +;; - Start redirected query with ASKING +;; +;; - TRYAGAIN => reshard in progress, wait to retry or throw + +;; - Possible READONLY / READWRITE commands during :init? +;; (Nb should affect kop-key) + +;; - Redis v7+ "Shared pub/sub" implications? + +;;;; Key slots + +(def ^:private ^:const num-key-slots 16384) +(let [xmodem-crc16-lookup + (long-array + [0x0000,0x1021,0x2042,0x3063,0x4084,0x50a5,0x60c6,0x70e7, + 0x8108,0x9129,0xa14a,0xb16b,0xc18c,0xd1ad,0xe1ce,0xf1ef, + 0x1231,0x0210,0x3273,0x2252,0x52b5,0x4294,0x72f7,0x62d6, + 0x9339,0x8318,0xb37b,0xa35a,0xd3bd,0xc39c,0xf3ff,0xe3de, + 0x2462,0x3443,0x0420,0x1401,0x64e6,0x74c7,0x44a4,0x5485, + 0xa56a,0xb54b,0x8528,0x9509,0xe5ee,0xf5cf,0xc5ac,0xd58d, + 0x3653,0x2672,0x1611,0x0630,0x76d7,0x66f6,0x5695,0x46b4, + 0xb75b,0xa77a,0x9719,0x8738,0xf7df,0xe7fe,0xd79d,0xc7bc, + 0x48c4,0x58e5,0x6886,0x78a7,0x0840,0x1861,0x2802,0x3823, + 0xc9cc,0xd9ed,0xe98e,0xf9af,0x8948,0x9969,0xa90a,0xb92b, + 0x5af5,0x4ad4,0x7ab7,0x6a96,0x1a71,0x0a50,0x3a33,0x2a12, + 0xdbfd,0xcbdc,0xfbbf,0xeb9e,0x9b79,0x8b58,0xbb3b,0xab1a, + 0x6ca6,0x7c87,0x4ce4,0x5cc5,0x2c22,0x3c03,0x0c60,0x1c41, + 0xedae,0xfd8f,0xcdec,0xddcd,0xad2a,0xbd0b,0x8d68,0x9d49, + 0x7e97,0x6eb6,0x5ed5,0x4ef4,0x3e13,0x2e32,0x1e51,0x0e70, + 0xff9f,0xefbe,0xdfdd,0xcffc,0xbf1b,0xaf3a,0x9f59,0x8f78, + 0x9188,0x81a9,0xb1ca,0xa1eb,0xd10c,0xc12d,0xf14e,0xe16f, + 0x1080,0x00a1,0x30c2,0x20e3,0x5004,0x4025,0x7046,0x6067, + 0x83b9,0x9398,0xa3fb,0xb3da,0xc33d,0xd31c,0xe37f,0xf35e, + 0x02b1,0x1290,0x22f3,0x32d2,0x4235,0x5214,0x6277,0x7256, + 0xb5ea,0xa5cb,0x95a8,0x8589,0xf56e,0xe54f,0xd52c,0xc50d, + 0x34e2,0x24c3,0x14a0,0x0481,0x7466,0x6447,0x5424,0x4405, + 0xa7db,0xb7fa,0x8799,0x97b8,0xe75f,0xf77e,0xc71d,0xd73c, + 0x26d3,0x36f2,0x0691,0x16b0,0x6657,0x7676,0x4615,0x5634, + 0xd94c,0xc96d,0xf90e,0xe92f,0x99c8,0x89e9,0xb98a,0xa9ab, + 0x5844,0x4865,0x7806,0x6827,0x18c0,0x08e1,0x3882,0x28a3, + 0xcb7d,0xdb5c,0xeb3f,0xfb1e,0x8bf9,0x9bd8,0xabbb,0xbb9a, + 0x4a75,0x5a54,0x6a37,0x7a16,0x0af1,0x1ad0,0x2ab3,0x3a92, + 0xfd2e,0xed0f,0xdd6c,0xcd4d,0xbdaa,0xad8b,0x9de8,0x8dc9, + 0x7c26,0x6c07,0x5c64,0x4c45,0x3ca2,0x2c83,0x1ce0,0x0cc1, + 0xef1f,0xff3e,0xcf5d,0xdf7c,0xaf9b,0xbfba,0x8fd9,0x9ff8, + 0x6e17,0x7e36,0x4e55,0x5e74,0x2e93,0x3eb2,0x0ed1,0x1ef0])] + + (defn- crc16 + "Returns hash for given bytes using the Redis Cluster CRC16 algorithm, + Ref. (Appendix A). + + Thanks to @bpoweski for this implementation." + [^bytes ba] + (let [len (alength ba)] + (loop [n 0 + crc 0] ; Inlines faster than `enc/reduce-n` + (if (>= n len) + crc + (recur (unchecked-inc n) + (bit-xor (bit-and (bit-shift-left crc 8) 0xffff) + (aget xmodem-crc16-lookup + (-> (bit-shift-right crc 8) + (bit-xor (aget ba n)) + (bit-and 0xff)))))))))) + +(defn- ba->key-slot [^bytes ba] (mod (crc16 ba) num-key-slots)) +(defn- tag-str->key-slot [^String tag-str] (ba->key-slot (enc/str->utf8-ba tag-str))) + +(defprotocol IClusterKey (^:public cluster-key [redis-key] "TODO: Docstring")) +(deftype ClusterKey [^bytes ba ^long slot] + clojure.lang.IDeref (deref [this] slot) ; For tests + IClusterKey (cluster-key [this] this)) + +(extend-type (Class/forName "[B") + IClusterKey (cluster-key [ba] (ClusterKey. ba (ba->key-slot ba)))) + +(extend-type String + IClusterKey + (cluster-key [s] + (let [s-ba (enc/str->utf8-ba s)] + (if-let [tag-str + (when (enc/str-contains? s "{") + (when-let [match (re-find #"\{(.*?)\}" s)] + (when-let [^String tag (get match 1)] ; "bar" in "foo{bar}{baz}" + (when-not (.isEmpty tag) tag))))] + + (ClusterKey. s-ba (tag-str->key-slot tag-str)) + (ClusterKey. s-ba (ba->key-slot s-ba)))))) + +(defn cluster-slot [x] (when (instance? ClusterKey x) (.-slot ^ClusterKey x))) + +(comment + (enc/qb 1e5 ; [7.59 22.92] + (cluster-key "foo") + (cluster-key "ignore{foo}"))) + +;;;; + +(comment + (def sm + (sorted-map + [12 30] "a" + [16 18] "b")) + + (defn find-entry [sm ^long n] + (reduce-kv + (fn [acc lohi v] + (if (and + (>= n ^long (get lohi 0)) + (<= n ^long (get lohi 1))) + (reduced v) + nil)) + nil + sm)) + + (comment (find-entry sm 16))) diff --git a/src/taoensso/carmine_v4/conns.clj b/src/taoensso/carmine_v4/conns.clj new file mode 100644 index 0000000..c2e42d7 --- /dev/null +++ b/src/taoensso/carmine_v4/conns.clj @@ -0,0 +1,707 @@ +(ns ^:no-doc taoensso.carmine-v4.conns + "Private ns, implementation detail. + Carmine connection handling code." + (:refer-clojure :exclude [binding]) + (:require + [taoensso.encore :as enc :refer [have have? binding]] + [taoensso.carmine-v4.utils :as utils] + [taoensso.carmine-v4.resp :as resp] + [taoensso.carmine-v4.opts :as opts]) + + (:import + [java.net Socket] + [java.io DataInputStream BufferedOutputStream] + [org.apache.commons.pool2 PooledObjectFactory] + [org.apache.commons.pool2.impl GenericObjectPool DefaultPooledObject] + [java.util.concurrent.atomic AtomicLong])) + +(comment (remove-ns 'taoensso.carmine-v4.conns)) + +(enc/declare-remote + taoensso.carmine-v4.sentinel/resolve-addr! + taoensso.carmine-v4.sentinel/resolved-addr? + ^:dynamic taoensso.carmine-v4.sentinel/*mgr-cbs* + ^:dynamic taoensso.carmine-v4/*conn-cbs* + taoensso.carmine-v4/default-pool-opts) + +(alias 'core 'taoensso.carmine-v4) +(alias 'sentinel 'taoensso.carmine-v4.sentinel) + +(defmacro ^:private debug! [& body] (when #_true false `(enc/println ~@body))) + +;;;; Connections + +(defprotocol ^:private IConn + "Internal protocol, not for public use or extension." + + (conn-open? [conn] "Returns true iff `Conn` is open.") + (conn-resolved? [conn use-cache?] + "Returns true iff `Conn` doesn't use Sentinel for server address resolution, + or if address agrees with current (possibly cached) resolution.") + + (conn-ready? [conn] + "Returns true iff `Conn` is open and healthy (address agrees with current + Sentinel resolution cache, and test PING successful).") + + (conn-init! [conn] + "Initializes `Conn` auth, protocol, etc. Returns true on success, or throws.") + + (conn-close! [conn data] + "Closes `Conn` and returns true iff successful. + `data` is an arb map to include in errors, and to provide to registered callbacks.")) + +(let [idx (java.util.concurrent.atomic.AtomicLong. 0)] + (defn- next-client-name! [_conn-opts] + (str "carmine:" (.incrementAndGet idx)))) + +(comment (next-client-name! nil)) + +(deftype ^:private Conn + [^Socket socket host port conn-opts ^DataInputStream in ^BufferedOutputStream out open?_] + + java.io.Closeable (close [this] (conn-close! this {:via 'java.io.Closeable})) + Object + (toString [this] + ;; "taoensso.carmine.Conn[127.0.0.1:6379 open 0x7b9f6831]" + (str "taoensso.carmine.Conn[" host ":" port " " + (if (open?_) "open" "closed") " " + (enc/ident-hex-str this) "]")) + + clojure.lang.IDeref + (deref [this] + {:socket socket + :host host + :port port + :conn-opts conn-opts + :in in + :out out + :open? (open?_)}) + + IConn + (conn-open? [this] (open?_)) + (conn-resolved? [this use-cache?] + (if-let [{:keys [sentinel-spec master-name sentinel-opts]} (opts/get-sentinel-server conn-opts)] + (sentinel/resolved-addr? sentinel-spec master-name sentinel-opts [host port] use-cache?) + true)) + + (conn-ready? [this] + (if-not (open?_) + false + (let [t0 (System/currentTimeMillis) + error_ (volatile! nil) + pass? + (and + (if (conn-resolved? this :use-cache) + true + (do + (vreset! error_ (ex-info "`Conn` incorrectly resolved" {})) + false)) + + (let [current-timeout-ms (.getSoTimeout socket) + ready-timeout-ms (or (utils/get-at conn-opts :socket-opts :ready-timeout-ms) 0)] + + (.setSoTimeout socket (int ready-timeout-ms)) + (if-let [reply + (try + ;; Nb assume any necessary auth/init already done, otherwise + ;; will correctly identify connection as unready + (resp/basic-ping! in out) + (catch Throwable t (vreset! error_ t) nil) + (finally (.setSoTimeout socket current-timeout-ms)))] + + (let [;; Ref. + ready? (or (= reply "PONG") (= reply ["ping" ""]))] + + (debug! :conn-ready? ready?) + (if ready? + true + (do + (vreset! error_ + (ex-info "Unexpected PING reply" + {:reply (enc/typed-val reply)})) + false))) + false))) + + elapsed-ms (- (System/currentTimeMillis) t0)] + + (if pass? + true + (do + (utils/cb-notify! + (get core/*conn-cbs* :on-conn-error) + (utils/get-at conn-opts :cbs :on-conn-error) + (delay + {:cbid :on-conn-error + :host host + :port port + :conn this + :conn-opts conn-opts + :via 'conn-ready? + :cause @error_ + :elapsed-ms elapsed-ms})) + false))))) + + (conn-init! [this] + (if-not (open?_) + false + (enc/when-let + [init-opts (not-empty (get conn-opts :init)) + reqs + (not-empty + (enc/cond + (contains? init-opts :commands) + (get init-opts :commands) ; Complete override + + :let [{:keys [auth #_client-name select-db resp3?]} init-opts + {:keys [username password]} auth + username (or username "default") + + client-name + (let [v (get init-opts :client-name ::auto)] + (enc/cond + (identical? v ::auto) (next-client-name! conn-opts) + (fn? v) (v conn-opts) + :else v))] + + resp3? + (let [auth-req + (if password + ["HELLO" 3 "AUTH" username password "SETNAME" client-name] + ["HELLO" 3 "SETNAME" client-name])] + + (if select-db + [auth-req ["SELECT" select-db]] + [auth-req])) + + :else + (let [reqs [] + reqs (if password (conj reqs ["AUTH" username password])) + reqs (if client-name (conj reqs ["CLIENT" "SETNAME" client-name])) + reqs (if select-db (conj reqs ["SELECT" select-db]))] + reqs)))] + + (let [conn-error_ (volatile! nil) + t0 (System/currentTimeMillis) + replies + (try + (resp/with-replies in out :natural-reads :as-vec + (fn [] (run! resp/rcall* reqs))) + + (catch Throwable t (vreset! conn-error_ t) nil)) + + elapsed-ms (- (System/currentTimeMillis) t0) + success? + (and + replies + (not (enc/rfirst resp/reply-error? replies)))] + + (if success? + true ; Common case + (let [reqs->replies + (when replies + (enc/reduce-zip + (fn [acc req reply] + (conj acc + {:request req + :reply reply})) + [] reqs replies))] + + (utils/cb-notify-and-throw! :on-conn-error + (get core/*conn-cbs* :on-conn-error) + (utils/get-at conn-opts :cbs :on-conn-error) + (ex-info "[Carmine] Error initializing connection" + {:eid :carmine.conns/conn-init-error + :host host + :port port + :conn this + :conn-opts conn-opts + :replies reqs->replies + :elapsed-ms elapsed-ms} + @conn-error_)))))))) + + (conn-close! [this data] + (debug! :conn-close! data) + (when (compare-and-set! open?_ true false) + (let [t0 (System/currentTimeMillis) + closed? (enc/catching (do (.close socket) true)) + elapsed-ms (- (System/currentTimeMillis) t0)] + + (utils/cb-notify! + (get core/*conn-cbs* :on-conn-close) + (utils/get-at conn-opts :cbs :on-conn-close) + (delay + {:cbid :on-conn-close + :host host + :port port + :conn this + :conn-opts conn-opts + :data data + :elapsed-ms elapsed-ms + :closed? closed?})) + true)))) + +(defn- conn? [x] (instance? Conn x)) + +(let [factory_ (delay (javax.net.ssl.SSLSocketFactory/getDefault))] + (defn- new-ssl-socket + "Given an existing connected but unencrypted `java.net.Socket`, returns a + connected and SSL-encrypted `java.net.Socket` using (SSLSocketFactory/getDefault)." + [^Socket socket ^String host port] + (.createSocket ^javax.net.ssl.SSLSocketFactory @factory_ + socket host (int port) true))) + +(defn- new-socket ^Socket [conn-opts socket-opts host port] + (let [socket + (doto (Socket.) + (.setTcpNoDelay true) + (.setKeepAlive true) + (.setReuseAddress true)) + + {:keys [connect-timeout-ms ssl] + :or ; Defaults relevant only for REPL/tests + {connect-timeout-ms 2000}} socket-opts + + socket-opts (dissoc socket-opts :connect-timeout-ms :ssl) + + ^Socket socket + (if socket-opts + (opts/set-socket-opts! socket socket-opts) + (do socket))] + + (.connect socket + (java.net.InetSocketAddress. ^String host (int port)) + (int (or connect-timeout-ms 0))) + + (if ssl + (if (fn? ssl) + (ssl conn-opts socket host port) ; Custom ssl-fn + (new-ssl-socket socket host port)) + + socket))) + +(comment (.close (new-socket nil {:ssl true :connect-timeout-ms 2000} "127.0.0.1" 6379))) + +(defn- new-conn + "Low-level implementation detail. + Returns a new `Conn` for given `conn-opts` with support for Sentinel resolution." + (^Conn [conn-opts] + (let [t0 (System/currentTimeMillis) + {:keys [server]} conn-opts] + + (enc/cond + (vector? server) (let [[host port] server] (new-conn conn-opts t0 nil host port)) + (map? server) ; As `opts/get-sentinel-server` + (let [{:keys [master-name sentinel-spec sentinel-opts]} server + [host port] + (sentinel/resolve-addr! ; May trigger `:on-changed-master` cb + sentinel-spec master-name + sentinel-opts (not :use-cache))] + + (new-conn conn-opts t0 master-name host port)) + + (throw ; Shouldn't be possible after validation + (ex-info "[Carmine] Unexpected `:server` type" + {:server (enc/typed-val server)}))))) + + (^Conn [conn-opts t0 master-name host port] + (let [host (have string? host) + port (enc/as-int port) + + {:keys [#_server socket-opts buffer-opts]} conn-opts + {:keys [init-size-in init-size-out] + :or ; Defaults relevant only for REPL/tests + {init-size-in 1024 + init-size-out 1024}} buffer-opts] + + (debug! :new-conn [host port]) + (try + ;; Could use Jedis streams below but initial benching showed little benefit: + ;; - `jedis.RedisInputStream`: readIntCrLf, readLongCrLf, readLineBytes + ;; - `jedis.RedisOutputStream`: writeIntCrLf, writeCrLf + ;; + (let [socket (new-socket conn-opts socket-opts host port) + in (-> socket .getInputStream (java.io.BufferedInputStream. init-size-in) java.io.DataInputStream.) + out (-> socket .getOutputStream (java.io.BufferedOutputStream. init-size-out)) + conn (Conn. socket host port conn-opts in out (enc/latom true))] + + (conn-init! conn) + (do conn)) + + (catch Throwable t + (utils/cb-notify-and-throw! :on-conn-error + (get core/*conn-cbs* :on-conn-error) + (utils/get-at conn-opts :cbs :on-conn-error) + (ex-info "[Carmine] Error creating new connection" + {:eid :carmine.conns/new-conn-error + :host host + :port port + :master-name master-name + :conn-opts conn-opts + :elapsed-ms (when t0 (- (System/currentTimeMillis) ^long t0))} + t))))))) + +(comment + (enc/qb 1e3 ; [42.83 55.34], port limited + (conn-close! (new-conn {} 0 nil "127.0.0.1" 6379) nil) + (conn-close! (new-conn {:socket-opts {:ssl true}} 0 nil "127.0.0.1" 6379) nil))) + +(defn- with-conn [^Conn conn f] + (try + (f conn (.-in conn) (.-out conn)) + (finally (conn-close! conn {:via 'with-new-conn})))) + +(defn with-new-conn + "For internal use only." + ([conn-opts f] (with-conn (new-conn conn-opts) f)) + ([conn-opts host port master-name f] + (with-conn + (new-conn conn-opts (System/currentTimeMillis) master-name host port) + f))) + +(comment (with-new-conn {} "127.0.0.1" 6379 nil (fn [conn in out] (conn-ready? conn)))) + +;;;; Connection managers + +(defprotocol ^:private IConnManager + "Internal protocol, not currently for public use or extension." + + (^:public mgr-ready? [mgr] + "Returns true iff `ConnManager` is ready for borrowing (not closed, etc.).") + + (mgr-clear! [mgr timeout-ms] + "Instructs `ConnManager` to clear currently pooled connections, destroying + idle or returned `Conns`. + + Blocks up to `timeout-ms` (nil => no limit) to await the return of active conns + before forcibly interrupting any conns still active after wait. + + Returns true iff clearing was performed without forced interruption. + Automatically called when Redis master changes due to Sentinel failover.") + + (mgr-borrow! [mgr f] + "Borrows a connection and calls + (f ), + returning the result. + + Returns or invalidates the borrowed connection when done.") + + (^:public mgr-close! [mgr timeout-ms data] + "Initiates a permanent shutdown of the `ConnManager`: + - Stops accepting new borrow requests. + - Destroys any idle or returned `Conns`. + + - Blocks up to `timeout-ms` (nil => no limit) to await the return of active conns + before forcibly interrupting any conns still active after wait. + + NB interruption can be dangerous to data integrity: pipelines may be interrupted + mid-execution, etc. Use a non-nil timeout only if you understand the risks!")) + +(defn ^:public conn-manager? + "Returns true iff given argument satisfies the `IConnManager` + protocol, and so can be used as a Carmine connection manager." + [x] + (or + #_(enc/satisfies? IConnManager x) + (satisfies? IConnManager x))) + +(defn- drain-conns! + "Blocks up to `timeout-ms` (nil => no limit) to await the closing of given + `Conn`s before forcibly interrupting any still open after timeout. + Returns true iff timeout wasn't triggered." + [conns timeout-ms close-data] + (cond + (empty? conns) true + (and timeout-ms (neg? ^long timeout-ms)) nil ; Undocumented + :else + (let [timeout-udt (when timeout-ms (+ (System/currentTimeMillis) ^long timeout-ms))] + (loop [conns conns] + (let [conns (into #{} (filter #(conn-open? %)) conns)] ; Open conns + (cond + (empty? conns) true + + (when timeout-udt (>= (System/currentTimeMillis) ^long timeout-udt)) + (do ; Give up waiting + (run! #(enc/catching (conn-close! % close-data)) conns) + false) + + :else (do (Thread/sleep 100) (recur conns)))))))) + +(comment + (let [c1 (new-conn {} 0 nil "127.0.0.1" 6379)] + (future (Thread/sleep 200) (conn-close! c1 {})) + (drain-conns! #{c1} 100 {}))) + +(defn- throw-mgr-closed! [mgr] (throw (ex-info "[Carmine] Cannot borrow from closed `ConnManager`" {:mgr mgr}))) +(defn- throw-mgr-borrow-error! [mgr conn-opts t0 t] + (throw + (ex-info "[Carmine] Error borrowing connection from `ConnManager`" + {:eid :carmine.conns/borrow-conn-error + :mgr mgr + :conn-opts conn-opts + :elapsed-ms (when t0 (- (System/currentTimeMillis) ^long t0))} + t))) + +(deftype ConnManagerUnpooled + [mgr-opts conn-opts closed?_ active-conns_ + ^AtomicLong n-created* ^AtomicLong n-failed*] + + java.io.Closeable (close [this] (mgr-close! this nil {:mgr this, :via 'java.io.Closeable})) + Object + (toString [this] + ;; "taoensso.carmine.ConnManagerUnpooled[ready 0x7b9f6831]" + (let [status (if (closed?_) "closed" "ready") + id (or (get mgr-opts :mgr-name) (enc/ident-hex-str this))] + (str "taoensso.carmine.ConnManagerUnpooled[" status " " id "]"))) + + clojure.lang.IDeref + (deref [_] + {:ready? (not (closed?_)) + :mgr-opts mgr-opts + :conn-opts conn-opts + :stats + {:counts + {:active (count @active-conns_) + :created (.get n-created*) + :failed (.get n-failed*)}}}) + + IConnManager + (mgr-ready? [_] (not (closed?_))) + (mgr-clear! [_ timeout-ms] nil) ; No-op + (mgr-borrow! [this f] + (debug! :unpooled/borrow!) + (if (closed?_) + (throw-mgr-closed! this) + (let [t0 (System/currentTimeMillis) + ^Conn conn + (try + (new-conn conn-opts) + (catch Throwable t + (.getAndIncrement n-failed*) + (throw-mgr-borrow-error! this conn-opts t0 t)))] + + (.getAndIncrement n-created*) + (active-conns_ #(conj % conn)) + (try + (let [result (f conn (.-in conn) (.-out conn))] + (conn-close! conn {:mgr this, :via 'mgr-borrow!}) + result) + + (catch Throwable t + (conn-close! conn {:mgr this, :via 'mgr-borrow!, :cause t}) + (throw t)) + + (finally (active-conns_ #(disj % conn))))))) + + (mgr-close! [this timeout-ms data] + (debug! :unpooled/close! timeout-ms data) + (when (compare-and-set! closed?_ false true) + (drain-conns! @active-conns_ timeout-ms + (enc/fast-merge {:mgr this, :via 'mgr-close!, :timeout-ms timeout-ms} data)) + true))) + +(let [idx (java.util.concurrent.atomic.AtomicLong. 0) + next-mgr-name! (fn [] (str "unpooled:" (.incrementAndGet idx)))] + + (defn ^:public conn-manager-unpooled + "Returns a new stateful unpooled `ConnManager`. + In most cases you should prefer `conn-manager-pooled` instead. + + `ConnManager` API: + - Deref for status, stats, etc. + - Close with `conn-manager-close!` or `java.io.Closeable`." + ^ConnManagerUnpooled [{:as opts :keys [conn-opts mgr-name]}] + (let [conn-opts (opts/parse-conn-opts false conn-opts) + mgr-name (let [v (get opts :mgr-name ::auto)] (if (identical? v ::auto) (next-mgr-name!) v)) + mgr-opts + (not-empty + (enc/assoc-some (dissoc opts :conn-opts) + :mgr-name mgr-name))] + + (ConnManagerUnpooled. mgr-opts conn-opts + (enc/latom false) + (enc/latom #{}) + (AtomicLong. 0) + (AtomicLong. 0))))) + +(def ^:private ^:dynamic *mgr-close-data* nil) + +(deftype ConnManagerPooled + ;; Ref. `org.apache.commons.pool2.impl.GenericObjectPool`, + ;; `org.apache.commons.pool2.PooledObjectFactory` + [mgr-opts conn-opts ^GenericObjectPool pool active-conns_ closed?_ + ^AtomicLong n-failed* ^AtomicLong n-cleared*] + + java.io.Closeable (close [this] (mgr-close! this nil {:mgr this, :via 'java.io.Closeable})) + Object + (toString [this] + ;; "taoensso.carmine.ConnManagerPooled[ready 0x7b9f6831]" + (let [status (if (closed?_) "closed" "ready") + id (or (get mgr-opts :mgr-name) (enc/ident-hex-str this))] + (str "taoensso.carmine.ConnManagerPooled[" status " " id "]"))) + + clojure.lang.IDeref + (deref [_] + {:ready? (not (closed?_)) + :mgr-opts mgr-opts + :conn-opts conn-opts + :stats + {:mean-borrow-time (.getMaxBorrowWaitTimeMillis pool) + :max-borrow-time (.getMeanBorrowWaitTimeMillis pool) + + :mean-idle-time (.getMeanIdleTimeMillis pool) + :mean-active-time (.getMeanActiveTimeMillis pool) + + :counts + {:created (.getCreatedCount pool) + :borrowed (.getBorrowedCount pool) + :returned (.getReturnedCount pool) + :destroyed + {:total (.getDestroyedCount pool) + :by-borrow-validation (.getDestroyedByBorrowValidationCount pool) + :by-eviction (.getDestroyedByEvictorCount pool)} + + :active (.getNumActive pool) + :waiting (.getNumWaiters pool) + :idle (.getNumIdle pool) + :failed (.get n-failed*) + :cleared (.get n-cleared*)}}}) + + IConnManager + (mgr-ready? [_] (and (not (closed?_)) (not (.isClosed pool)))) + (mgr-clear! [this timeout-ms] + (debug! :pooled/clear!) + (when-not (closed?_) + (.getAndIncrement n-cleared*) + (let [old-conns (into #{} (remove #(conn-resolved? % :use-cache)) (active-conns_))] + (.clear pool) ; 1. Clear idle conns + + ;; 2. Drain old active conns + (drain-conns! old-conns timeout-ms + {:mgr this, :via 'mgr-clear!, :timeout-ms timeout-ms}) + + ;; 3. No need to specially invalidate returned conns since all + ;; returned conns are anyway always tested for `conn-resolved?` + ))) + + (mgr-borrow! [this f] + (debug! :pooled/borrow!) + (if (closed?_) + (throw-mgr-closed! this) + (let [t0 (System/currentTimeMillis) + ^Conn conn (.borrowObject pool)] + (active-conns_ #(conj % conn)) + (try + (let [result (f conn (.-in conn) (.-out conn))] + + ;; Always test `conn-resolved?` before returning, it's cheap + ;; and needed for correct clearing behaviour after master change + (if (conn-resolved? conn :use-cache) + (do (.returnObject pool conn)) + (binding [*mgr-close-data* {:mgr this, :via 'mgr-borrow!}] (.invalidateObject pool conn))) + + result) + + (catch Throwable t + ;; We're conservative here and invalidate conn for ANY cause since even if + ;; conn is intact, it may be in an unexpected state + (binding [*mgr-close-data* {:mgr this, :via 'mgr-borrow!, :cause t}] + (.invalidateObject pool conn)) + (throw t)) + + (finally (active-conns_ #(disj % conn))))))) + + (mgr-close! [this timeout-ms data] + (debug! :pooled/close! timeout-ms data) + (when (compare-and-set! closed?_ false true) + (drain-conns! @active-conns_ timeout-ms + (enc/fast-merge {:mgr this, :via 'mgr-close!, :timeout-ms timeout-ms} data)) + (.close pool) + true))) + +(let [idx (java.util.concurrent.atomic.AtomicLong. 0) + next-mgr-name! (fn [] (str "pooled:" (.incrementAndGet idx)))] + + (defn ^:public conn-manager-pooled + "Returns a new stateful pooled `ConnManager` backed by Apache Commons Pool 2. + + This is a solid and highly configurable general-purpose connection + manager that should generally be your default choice unless you have very + specific/unusual requirements. + + `ConnManager` API: + - Deref for status, stats, etc. + - Close with `conn-manager-close!` or `java.io.Closeable`. + + Options: + `:pool-opts` + Options for manager's underlying `org.apache.commons.pool2.impl.GenericObjectPool`. + For more info, see `default-pool-opts` or the `GenericObjectPool` Javadoc." + + ^ConnManagerPooled [{:as opts :keys [conn-opts pool-opts mgr-name]}] + (let [conn-opts (opts/parse-conn-opts false conn-opts) + mgr-name (let [v (get opts :mgr-name ::auto)] (if (identical? v ::auto) (next-mgr-name!) v)) + mgr-opts + (not-empty + (enc/assoc-some (dissoc opts :conn-opts) + :mgr-name mgr-name)) + + mgr_ (volatile! nil) + n-failed* (AtomicLong. 0) + n-cleared* (AtomicLong. 0) + pool + (let [sentinel-mgr-cbs + (when-let [{:keys [master-name sentinel-opts]} (opts/get-sentinel-server conn-opts)] + (let [{:keys [clear-timeout-ms]} sentinel-opts] + {:on-changed-master + (fn [{master-name* :master-name}] + (when-let [mgr @mgr_] + (when (= master-name* master-name) + (mgr-clear! mgr clear-timeout-ms))))})) + + factory + (reify PooledObjectFactory + (activateObject [_ po] nil) + (passivateObject [_ po] nil) + (validateObject [_ po] (conn-ready? (.getObject po))) + (destroyObject [_ po] (conn-close! (.getObject po) *mgr-close-data*)) + (makeObject [_] + (let [t0 (System/currentTimeMillis)] + (try + (if-let [cbs sentinel-mgr-cbs] + (binding [sentinel/*mgr-cbs* cbs] (DefaultPooledObject. (new-conn conn-opts))) + (do (DefaultPooledObject. (new-conn conn-opts)))) + + (catch Throwable t + (.getAndIncrement n-failed*) + (throw-mgr-borrow-error! @mgr_ conn-opts t0 t)))))) + + pool-opts (utils/merge-opts core/default-pool-opts pool-opts) + pool (GenericObjectPool. factory)] + + (opts/set-pool-opts! pool pool-opts) + (do pool)) + + mgr + (vreset! mgr_ + (ConnManagerPooled. mgr-opts conn-opts pool + (enc/latom #{}) + (enc/latom false) + n-failed* + n-cleared*))] + + (.preparePool pool) ; Ensure that configured min idle instances ready + mgr))) + +(comment + (let [m1 (conn-manager-unpooled {}) + m2 (conn-manager-pooled {})] + (enc/qb 1e3 ; [80.49 19.06], m1 port limited + (mgr-borrow! m1 (fn [c in out] #_(conn-ready? c))) + (mgr-borrow! m2 (fn [c in out] #_(conn-ready? c)))))) + +;;;; Print methods + +(do + (enc/def-print-impl [x Conn] (str "#" x)) + (enc/def-print-impl [x ConnManagerUnpooled] (str "#" x)) + (enc/def-print-impl [x ConnManagerPooled] (str "#" x))) diff --git a/src/taoensso/carmine_v4/opts.clj b/src/taoensso/carmine_v4/opts.clj new file mode 100644 index 0000000..1470110 --- /dev/null +++ b/src/taoensso/carmine_v4/opts.clj @@ -0,0 +1,286 @@ +(ns ^:no-doc taoensso.carmine-v4.opts + "Private ns, implementation detail. + Carmine has a lot of options, so we do our best to: + - Coerce and validate early when possible. + - Throw detailed error messages when issues occur." + (:require + [clojure.string :as str] + [taoensso.encore :as enc :refer [have have?]] + [taoensso.carmine-v4.utils :as utils]) + + (:import + [java.net Socket] + [org.apache.commons.pool2.impl + BaseGenericObjectPool + GenericObjectPool GenericKeyedObjectPool])) + +(comment (remove-ns 'taoensso.carmine-v4.opts)) + +(enc/declare-remote + taoensso.carmine-v4/default-conn-opts + taoensso.carmine-v4/default-sentinel-opts + taoensso.carmine-v4.conns/conn-manager? + taoensso.carmine-v4.sentinel/sentinel-spec? + taoensso.carmine-v4.sentinel/sentinel-opts) + +(do + (alias 'core 'taoensso.carmine-v4) + (alias 'conns 'taoensso.carmine-v4.conns) + (alias 'sentinel 'taoensso.carmine-v4.sentinel)) + +;;;; Mutators + +(defn set-socket-opts! + ^Socket [^Socket s socket-opts] + (enc/run-kv! + (fn [k v] + (case k + ;; Carmine options, noop and pass through + (:ssl :connect-timeout-ms :ready-timeout-ms) nil + + (:setKeepAlive :keep-alive?) (.setKeepAlive s (boolean v)) + (:setOOBInline :oob-inline?) (.setOOBInline s (boolean v)) + (:setTcpNoDelay :tcp-no-delay?) (.setTcpNoDelay s (boolean v)) + (:setReuseAddress :reuse-address?) (.setReuseAddress s (boolean v)) + + (:setReceiveBufferSize :receive-buffer-size) (.setReceiveBufferSize s (int v)) + (:setSendBufferSize :send-buffer-size) (.setSendBufferSize s (int v)) + (:setSoTimeout :so-timeout :read-timeout-ms) (.setSoTimeout s (int (or v 0))) + + ;; (:setSocketImplFactory :socket-impl-factory) (.setSocketImplFactory s v) + (:setTrafficClass :traffic-class) (.setTrafficClass s v) + + (:setSoLinger :so-linger) + (let [[on? linger] (have vector? v)] + (.setSoLinger s (boolean on?) (int linger))) + + (:setPerformancePreferences :performance-preferences) + (let [[conn-time latency bandwidth] (have vector? v)] + (.setPerformancePreferences s (int conn-time) (int latency) (int bandwidth))) + + (throw + (ex-info "[Carmine] Unknown socket option specified" + {:eid :carmine.conns/unknown-socket-option + :opt-key (enc/typed-val k) + :opt-val (enc/typed-val v) + :all-opts socket-opts})))) + socket-opts) + s) + +(defn set-pool-opts! + [^BaseGenericObjectPool p pool-opts] + (let [neg-duration (java.time.Duration/ofSeconds -1)] + (enc/run-kv! + (fn [k v] + (case k + ;;; org.apache.commons.pool2.impl.GenericObjectPool + (:setMinIdle :min-idle) (.setMinIdle ^GenericObjectPool p (int (or v -1))) + (:setMaxIdle :max-idle) (.setMaxIdle ^GenericObjectPool p (int (or v -1))) + + ;;; org.apache.commons.pool2.impl.GenericKeyedObjectPool + (:setMinIdlePerKey :min-idle-per-key) (.setMinIdlePerKey ^GenericKeyedObjectPool p (int (or v -1))) + (:setMaxIdlePerKey :max-idle-per-key) (.setMaxIdlePerKey ^GenericKeyedObjectPool p (int (or v -1))) + (:setMaxTotalPerKey :max-total-per-key) (.setMaxTotalPerKey ^GenericKeyedObjectPool p (int (or v -1))) + + ;;; org.apache.commons.pool2.impl.BaseGenericObjectPool + (:setBlockWhenExhausted :block-when-exhausted?) (.setBlockWhenExhausted p (boolean v)) + (:setLifo :lifo?) (.setLifo p (boolean v)) + + (:setMaxTotal :max-total) (.setMaxTotal p (int (or v -1))) + (:setMaxWaitMillis :max-wait-ms) (.setMaxWaitMillis p (long (or v -1))) + (:setMaxWait :max-wait) (.setMaxWait p (or v neg-duration)) + + (:setMinEvictableIdleTimeMillis :min-evictable-idle-time-ms) (.setMinEvictableIdleTimeMillis p (long (or v -1))) + (:setMinEvictableIdle :min-evictable-idle) (.setMinEvictableIdle p (or v neg-duration)) + (:setSoftMinEvictableIdleTimeMillis :soft-min-evictable-idle-time-ms) (.setSoftMinEvictableIdleTimeMillis p (long (or v -1))) + (:setSoftMinEvictableIdle :soft-min-evictable-idle) (.setSoftMinEvictableIdle p (or v neg-duration)) + (:setNumTestsPerEvictionRun :num-tests-per-eviction-run) (.setNumTestsPerEvictionRun p (int (or v 0))) + (:setTimeBetweenEvictionRunsMillis :time-between-eviction-runs-ms) (.setTimeBetweenEvictionRunsMillis p (long (or v -1))) + (:setTimeBetweenEvictionRuns :time-between-eviction-runs) (.setTimeBetweenEvictionRuns p (or v neg-duration)) + + (:setEvictorShutdownTimeoutMillis :evictor-shutdown-timeout-ms) (.setEvictorShutdownTimeoutMillis p (long v)) + (:setEvictorShutdownTimeout :evictor-shutdown-timeout) (.setEvictorShutdownTimeout p v) + + (:setTestOnCreate :test-on-create?) (.setTestOnCreate p (boolean v)) + (:setTestWhileIdle :test-while-idle?) (.setTestWhileIdle p (boolean v)) + (:setTestOnBorrow :test-on-borrow?) (.setTestOnBorrow p (boolean v)) + (:setTestOnReturn :test-on-return?) (.setTestOnReturn p (boolean v)) + + (:setSwallowedExceptionListener :swallowed-exception-listener) + (.setSwallowedExceptionListener p v) + (throw + (ex-info "[Carmine] Unknown pool option specified" + {:eid :carmine.conns/unknown-pool-option + :opt-key (enc/typed-val k) + :opt-val (enc/typed-val v) + :all-opts pool-opts})))) + pool-opts)) + p) + +;;;; Misc + +(defn parse-sock-addr + "Returns valid [ ] socket address pair, or throws. + Retains metadata (server name, comments, etc.)." + ( [host port ] [(have string? host) (enc/as-int port)]) + ( [host port metadata] (with-meta [(have string? host) (enc/as-int port)] metadata)) + ([[host port :as addr]] + (have? string? host) + (assoc addr 1 (enc/as-int port)))) + +(defn descr-sock-addr + "Returns [ ] socket address." + [addr] (if-let [m (meta addr)] (conj addr m) addr)) + +(defn get-sentinel-server [conn-opts] + (let [{:keys [server]} conn-opts] + (when (and (map? server) (get server :sentinel-spec)) + server))) + +;;;; + +(declare ^:private parse-string-server ^:private parse-sentinel-server) + +(defn parse-conn-opts + "Returns valid parsed conn-opts, or throws." + [in-sentinel-opts? conn-opts] + (try + (have? [:or nil? map?] conn-opts) + (let [default-conn-opts + (if in-sentinel-opts? + (dissoc core/default-conn-opts :server) + (do core/default-conn-opts)) + + conn-opts (utils/merge-opts default-conn-opts conn-opts) + {:keys [server cbs socket-opts buffer-opts init]} conn-opts + {:keys [auth]} init] + + (if in-sentinel-opts? + ;; [host port] of Sentinel server will be auto added by resolver + (have? [:ks<= #{:id #_:server :cbs :socket-opts :buffer-opts :init}] conn-opts) + (have? [:ks<= #{:id :server :cbs :socket-opts :buffer-opts :init}] conn-opts)) + + (have? [:ks<= #{:on-conn-close :on-conn-error}] cbs) + (have? [:or nil? fn?] :in (vals cbs)) + + (when socket-opts (set-socket-opts! (java.net.Socket.) socket-opts)) ; Dry run + (have? [:ks<= #{:init-size-in :init-size-out}] buffer-opts) + + (if in-sentinel-opts? + (have? [:ks<= #{:commands :auth :resp3? #_:client-name #_:select-db}] init) + (have? [:ks<= #{:commands :auth :resp3? :client-name :select-db}] init)) + + (have? [:ks<= #{:username :password}] auth) + + (if in-sentinel-opts? + (do conn-opts) ; Doesn't have :server + (utils/merge-opts conn-opts + (try + (enc/cond + (vector? server) {:server (parse-sock-addr server)} + (string? server) (have map? (parse-string-server server)) + (map? server) + (case (set (keys server)) + #{:host :port} + (let [{:keys [host port]} server] {:server (parse-sock-addr host port (meta server))}) + (#{:master-name :sentinel-spec } + #{:master-name :sentinel-spec :sentinel-opts}) {:server (parse-sentinel-server server)} + + (do (throw (ex-info "Unexpected `:server` keys" {:keys (keys server)})))) + :else (throw (ex-info "Unexpected `:server` type" {:type (type server)}))) + + (catch Throwable t + (throw + (ex-info "[Carmine] Invalid Redis server specification in connection options" + {:eid :carmine.conn-opts/invalid-server + :server (enc/typed-val server) + :expected '(or uri-string [host port] {:keys [host port]} + {:keys [master-name sentinel-spec sentinel-opts]})} + t))))))) + + (catch Throwable t + (throw + (ex-info "[Carmine] Invalid connection options" + {:eid :carmine.conn-opts/invalid + :conn-opts (assoc (enc/typed-val conn-opts) :id (get conn-opts :id)) + :purpose + (if in-sentinel-opts? + :conn-to-sentinel-server + :conn-to-redis-server)} + t))))) + +;;;; + +(defn- parse-string-server + "\"rediss://user:pass@x.y.com:9475/3\" -> + {:keys [server init socket-opts]}, etc." + [s] + (let [uri (java.net.URI. (have string? s)) + server [(.getHost uri) (.getPort uri)] + init + (enc/assoc-some nil + :auth + (let [[username password] (.split (str (.getUserInfo uri)) ":")] + (enc/assoc-some nil + :username (enc/as-?nempty-str username) + :password (enc/as-?nempty-str password))) + + :select-db + (when-let [[_ db-str] (re-matches #"/(\d+)$" (.getPath uri))] + (Integer. ^String db-str))) + + socket-opts + (when-let [scheme (.getScheme uri)] + (when (contains? #{"rediss" "https"} (str/lower-case scheme)) + {:ssl true}))] + + (enc/assoc-some {:server server} + :init init + :socket-opts socket-opts))) + +(comment + [(parse-string-server "redis://user:pass@x.y.com:9475/3") + (parse-string-server "redis://:pass@x.y.com.com:9475/3") + (parse-string-server "redis://user:@x.y.com:9475/3") + (parse-string-server "rediss://user:@x.y.com:9475/3")]) + +(defn- parse-sentinel-server [server] + (have? map? server) + (let [{:keys [master-name sentinel-spec sentinel-opts]} server + + master-name (enc/as-qname (have [:or string? enc/named?] master-name)) + sentinel-opts + (let [sentinel-spec (have sentinel/sentinel-spec? sentinel-spec) + sentinel-opts + (utils/merge-opts core/default-sentinel-opts + (sentinel/sentinel-opts sentinel-spec) + sentinel-opts)] + + (try + (have? map? sentinel-opts) + (have? [:ks<= #{:id :conn-opts :cbs + :retry-delay-ms :resolve-timeout-ms :clear-timeout-ms + :update-sentinels? :update-replicas? :prefer-read-replica?}] + sentinel-opts) + + (let [{:keys [cbs]} sentinel-opts] + (have? [:ks<= #{:on-resolve-success :on-resolve-error + :on-changed-master :on-changed-replicas :on-changed-sentinels}] cbs) + (have? [:or nil? fn?] :in (vals cbs))) + + (if-let [conn-opts (not-empty (get sentinel-opts :conn-opts))] + (assoc sentinel-opts :conn-opts (parse-conn-opts true conn-opts)) + (do sentinel-opts)) + + (catch Throwable t + (throw + (ex-info "[Carmine] Invalid Sentinel options" + {:eid :carmine.sentinel-opts/invalid + :sentinel-opts + (assoc (enc/typed-val sentinel-opts) + :id (get sentinel-opts :id))} + t)))))] + + (assoc server + :master-name master-name + :sentinel-opts sentinel-opts))) diff --git a/src/taoensso/carmine_v4/resp.clj b/src/taoensso/carmine_v4/resp.clj new file mode 100644 index 0000000..51845be --- /dev/null +++ b/src/taoensso/carmine_v4/resp.clj @@ -0,0 +1,363 @@ +(ns ^:no-doc taoensso.carmine-v4.resp + "Private ns, implementation detail. + Implementation of the Redis RESP3 protocol, + Ref. " + (:refer-clojure :exclude [binding]) + (:require + [taoensso.encore :as enc :refer [binding]] + [taoensso.carmine-v4.resp.common :as com] + [taoensso.carmine-v4.resp.read :as read] + [taoensso.carmine-v4.resp.write :as write]) + + (:import [java.util LinkedList])) + +(comment (remove-ns 'taoensso.carmine-v4.resp)) + +(enc/declare-remote + ^:dynamic taoensso.carmine-v4.cluster/cluster-slot) + +(alias 'cluster 'taoensso.carmine-v4.cluster) + +;;;; Aliases + +(enc/defaliases com/reply-error com/reply-error?) + +;;;; + +(let [read-opts-natural com/read-opts-natural + ba-command (enc/str->utf8-ba "*1\r\n$4\r\nPING\r\n") + ba-len (alength ba-command)] + + (defn basic-ping! + "Low-level util. + Sends a minimally expensive single PING command directly to Redis, + and reads reply. Forgoes `Ctx`, read mode, parsing, etc." + [in ^java.io.BufferedOutputStream out] + (.write out ba-command 0 ba-len) + (.flush out) + (read/read-reply read-opts-natural in))) + +;;;; Request context + +(def ^:dynamic *ctx* nil) +(deftype Ctx [cluster? natural-reads? pending-reqs* pending-replies* conn-opts in out]) + +(deftype Req [read-opts args cluster-slot supports-cluster?]) +(deftype LocalEchoReq [read-opts reply]) + +;; TODO For command generation +;; - Create and .addLast relevant Req +;; - Set `supports-cluster?` (true => supported, false => unsupported, nil => unknown) +;; - Set `cluster-slot` based on detected cluster-key +;; - Use `throw-no-ctx!` if necessary + +(defn- throw-no-ctx! [called] + (throw + (ex-info "[Carmine] Called Redis command/s without `wcar` or `with-car` context." + {:eid :carmine/no-context + :called called}))) + +(defn- throw-cluster-not-supported! [command] + (throw + (ex-info "[Carmine] Called Redis command in Redis Cluster context that does not support Cluster." + {:eid :carmine/cluster-not-supported + :command command}))) + +(let [read-opts-natural com/read-opts-natural] + (defn- get-read-opts [^Ctx ctx] + (if (.-natural-reads? ctx) + read-opts-natural + (com/get-read-opts)))) + +(let [get-read-opts get-read-opts + cluster-slot cluster/cluster-slot] + + (defn ^:public rcall* + "Sends 1 arbitrary command to Redis server. + Takes a vector of args for the command call: + (wcar {} (rcall* [\"set\" \"my-key\" \"my-val\"])) => \"OK\" + + Useful for DSLs, and to call commands (including Redis module commands) + that might not yet have a native Clojure fn provided by Carmine." + [call-args] + (if-let [^Ctx ctx *ctx*] + (let [cluster-slot (when (.-cluster? ctx) (enc/rsome cluster-slot call-args))] + (.addLast ^LinkedList (.-pending-reqs* ctx) + (Req. (get-read-opts ctx) call-args cluster-slot nil)) + nil) + (throw-no-ctx! call-args))) + + (defn ^:public rcalls* + "Send >=0 arbitrary commands to Redis server. + Takes a vector of calls, with each call a vector of args: + (wcar {} + (rcalls* [[\"set\" \"my-key\" \"my-val\"] + [\"get\" \"my-key\"]])) => [\"OK\" \"my-val\"] + + Useful for DSLs, and to call commands (including Redis module commands) + that might not yet have a native Clojure fn provided by Carmine." + [calls] + (if-let [^Ctx ctx *ctx*] + (let [^LinkedList pending-reqs (.-pending-reqs* ctx) + read-opts (get-read-opts ctx) + cluster? (.-cluster? ctx)] + (run! + (fn [call-args] + (let [cluster-slot (when cluster? (enc/rsome cluster-slot call-args))] + (.addLast pending-reqs (Req. read-opts call-args cluster-slot nil)))) + calls) + nil) + (throw-no-ctx! calls)))) + +(let [rcall* rcall*] + (defn ^:public rcall + "Sends 1 arbitrary command to Redis server. + Takes varargs for the command call: + (wcar {} (rcall \"set\" \"my-key\" \"my-val\")) => \"OK\" + + Useful for DSLs, and to call commands (including Redis module commands) + that might not yet have a native Clojure fn provided by Carmine." + [& call-args] (rcall* call-args))) + +(let [rcalls* rcalls*] + (defn ^:public rcalls + "Send >=0 arbitrary commands to Redis server. + Takes vararg calls, with each call a vector of args: + (wcar {} + (rcall [\"set\" \"my-key\" \"my-val\"] + [\"get\" \"my-key\"])) => [\"OK\" \"my-val\"] + + Useful for DSLs, and to call commands (including Redis module commands) + that might not yet have a native Clojure fn provided by Carmine." + [& calls] (rcalls* calls))) + +(let [get-read-opts get-read-opts] + (defn ^:public local-echo + "Like the `echo` command except entirely local: no data is sent to/from Redis: + (wcar {} (local-echo \"foo\")) => \"foo\" + + Useful for DSLs and other advanced applications. Can be combined with + `with-replies` or nested `wcar` calls to achieve some very powerful effects." + [x] + (if-let [^Ctx ctx *ctx*] + (do + (.addLast ^LinkedList (.-pending-reqs* ctx) + (LocalEchoReq. (get-read-opts ctx) x)) + nil) + (throw-no-ctx! ["LOCAL-ECHO" x]))) + + (defn ^:public local-echos* + "Like `local-echo`, except takes a vector of >=0 args to echo." + [xs] + (if-let [^Ctx ctx *ctx*] + (let [^LinkedList pending-reqs (.-pending-reqs* ctx) + read-opts (get-read-opts ctx)] + (run! + (fn [x] (.addLast pending-reqs (LocalEchoReq. read-opts x))) + xs) + nil) + (throw-no-ctx! (into ["LOCAL-ECHOS"] xs)))) + + (defn ^:public local-echos + "Like `local-echo`, except takes >=0 varargs to echo." + [& xs] (local-echos* xs))) + +(do ; Basic commands for tests + (defn ping [] (rcall "PING")) + (defn echo [x] (rcall "ECHO" x)) + (defn rset [k v] (rcall "SET" k v)) + (defn rget [k] (rcall "GET" k))) + +;;;; Non-cluster API + +(declare + ^:private flush-pending-reqs + ^:private complete-replies) + +(defn with-replies + "Establishes (possibly-nested) `Ctx`, flushes requests in body, + and returns completed replies." + + ;; Add non-cluster ctx, used by `with-car` + ([in out natural-reads? as-vec? body-fn] + (when-let [^Ctx parent-ctx *ctx*] + (flush-pending-reqs parent-ctx)) + + (let [new-ctx (Ctx. false natural-reads? (LinkedList.) (LinkedList.) nil in out)] + (binding [*ctx* new-ctx] (body-fn)) + (flush-pending-reqs new-ctx) + (complete-replies as-vec? new-ctx))) + + ;; Add cluster ctx, used by `with-car` + ([conn-opts natural-reads? as-vec? body-fn] + (when-let [^Ctx parent-ctx *ctx*] + (flush-pending-reqs parent-ctx)) + + (let [new-ctx (Ctx. true natural-reads? (LinkedList.) (LinkedList.) conn-opts nil nil)] + (binding [*ctx* new-ctx] (body-fn)) + (flush-pending-reqs new-ctx) + (complete-replies as-vec? new-ctx))) + + ;; Add additional ctx, used by public `with-replies` + ([natural-reads? as-vec? body-fn] + (when-let [^Ctx parent-ctx *ctx*] + (flush-pending-reqs parent-ctx) + + (let [new-ctx + (if (.-cluster? parent-ctx) + (Ctx. true natural-reads? (LinkedList.) (LinkedList.) (.-conn-opts parent-ctx) nil nil) + (Ctx. false natural-reads? (LinkedList.) (LinkedList.) nil (.-in parent-ctx) (.-out parent-ctx)))] + + (binding [*ctx* new-ctx] (body-fn)) + (flush-pending-reqs new-ctx) + (complete-replies as-vec? new-ctx))))) + +(declare ^:private consume-list!) + +(let [sentinel-skipped-reply com/sentinel-skipped-reply] + (defn flush-pending-reqs [^Ctx ctx] + "Given a `Ctx` with pending-reqs* and pending-replies*: + - Consumes (mutates) all pending-reqs* + - Adds to (mutates) pending-replies* + + Returns the number of requests consumed (used only for + debugging/testing)." + (if (.-cluster? ctx) + (let [conn-opts (.-conn-opts ctx)] + + ;; See cluster ns for sketch: + ;; 1. Use partitioning util in cluster ns + ;; 2. Acquire conns to all shard-addrs with + ;; (get-conn (assoc conn-opts :server )) + ;; *. Comment that future-pool could be used here + ;; 3. Write to all shards, starting with READONLY/READWRITE (skipping replies) + ;; 4. Read from all shards + ;; 5. Handle cluster errors, with possible retries + ;; 6. Stitch back replies in correct order + (throw (ex-info "TODO: Cluster support not yet implemented" {}))) + + (let [^LinkedList pending-reqs* (.-pending-reqs* ctx) + n-pending-reqs (.size pending-reqs*)] + + (when (> n-pending-reqs 0) + (let [^LinkedList pending-replies* (.-pending-replies* ctx) + ^LinkedList consumed-reqs* (LinkedList.)] + + ;; Consume all pending requests, writing to Redis server + ;; without awaiting any replies (=> use pipelining). + (let [out (.-out ctx)] + (consume-list! + (fn [_ req] + (.add consumed-reqs* req) ; Move to consumed list + (enc/cond! + (instance? Req req) ; Common case + (let [args (.-args ^Req req)] + (write/write-array-len out (count args)) + (enc/run! (fn [arg] (write/write-bulk-arg arg out)) args)) + + ;; Noop, don't actually send anything to Redis + (instance? LocalEchoReq req) nil)) + nil pending-reqs* n-pending-reqs) + (.flush ^java.io.BufferedOutputStream out)) + + ;; Now re-consume all requests to read replies from Redis server + (let [in (.-in ctx)] + (consume-list! + (fn [_ req] + (let [completed-reply + (enc/cond! + (instance? Req req) ; Common case + (let [read-opts (.-read-opts ^Req req)] + (read/read-reply read-opts in)) + + (instance? LocalEchoReq req) + (let [read-opts (.-read-opts ^LocalEchoReq req) + reply (.-reply ^LocalEchoReq req)] + (read/complete-reply read-opts reply)))] + + (if (identical? completed-reply sentinel-skipped-reply) + nil ; Noop + (.add pending-replies* completed-reply)))) + nil consumed-reqs* n-pending-reqs)) + + n-pending-reqs)))))) + +(defn- consume-list! + ;; Note: we don't actually always NEED to consume (remove) items + ;; while iterating, but benching shows that doing so is almost + ;; as fast as non-consuming iteration - so we'll just always + ;; consume to keep things simple and safe. + ([f init ^LinkedList ll ] (consume-list! f init ll (.size ll))) + ([f init ^LinkedList ll n] + (when (> ^int n 0) + (enc/reduce-n (fn [acc _] (f acc (.removeFirst ll))) init n)))) + +(comment + (defn- ll ^LinkedList [n] (let [ll (LinkedList.)] (dotimes [n n] (.add ll n)) ll)) + (ll 10) + + (defn bench1 [n] + (enc/qb 1e5 + (doseq [x (ll n)]) + (let [l1 (ll n)] (enc/run! (fn [x]) l1)) + (let [l1 (ll n) + l2 (LinkedList.)] + (enc/reduce-n (fn [_ _] (.add l2 (.removeFirst l1))) nil (.size l1))))) + + (mapv bench1 [1 10 100]) + [[ 50.29 13.89 17.9] + [114.58 34.58 35.6] + [836.49 221.18 205.2]]) + +(let [reply-error? com/reply-error?] + + (defn- complete-replies + [as-vec? ^Ctx ctx] + + (if (.-cluster? ctx) + ;; TODO Any special handling needed here? + (throw (ex-info "TODO: Cluster support not yet implemented" {})) + + (let [^LinkedList pending-replies* (.-pending-replies* ctx) + n-replies (.size pending-replies*)] + + (enc/cond + (== n-replies 1) + (let [reply (.removeFirst pending-replies*)] + (if as-vec? + [reply] + (if (reply-error? reply) + (throw reply) + (do reply)))) + + (> n-replies 10) + (persistent! + (consume-list! conj! (transient []) + pending-replies* n-replies)) + + (> n-replies 0) + (consume-list! conj [] + pending-replies* n-replies)))))) + +;;;; + +(defn parse-body-reply-opts + "Returns [?reply-opts body]" + [body] + (let [[b1 & bn] body] + (case b1 + (:as-vec :as-pipeline) [{:as-vec? true} bn] + (cond + (set? b1) + (case b1 + #{} [nil bn] + #{:as-vec } [{:as-vec? true} bn] + #{ :natural-reads} [{:natural-reads? true} bn] + #{:as-vec :natural-reads} [{:as-vec? true + :natural-reads? true} bn] + (throw + (ex-info "[Carmine] Unexpected reply-opts in body" + {:opts (enc/typed-val b1)}))) + + (map? b1) [b1 bn] + :else [nil body])))) diff --git a/src/taoensso/carmine_v4/resp/common.clj b/src/taoensso/carmine_v4/resp/common.clj new file mode 100644 index 0000000..7475054 --- /dev/null +++ b/src/taoensso/carmine_v4/resp/common.clj @@ -0,0 +1,490 @@ +(ns ^:no-doc taoensso.carmine-v4.resp.common + "Private ns, implementation detail." + (:refer-clojure :exclude [binding]) + (:require + [taoensso.encore :as enc :refer [binding]] + [taoensso.carmine-v4.classes]) + + (:import + [java.nio.charset StandardCharsets] + [java.io DataInput DataInputStream] + [clojure.lang ExceptionInfo] + + [taoensso.carmine_v4.classes ReplyError])) + +(enc/declare-remote + ^:dynamic taoensso.carmine-v4/*auto-thaw?* + ^:dynamic taoensso.carmine-v4/*keywordize-maps?* + ^:dynamic taoensso.carmine-v4/*issue-83-workaround?*) + +(alias 'core 'taoensso.carmine-v4) + +(comment (remove-ns 'taoensso.carmine-v4.resp.common)) + +;;;; Utils + +(def ba-crlf (enc/str->utf8-ba "\r\n")) + +(defn ba->in ^DataInputStream [^bytes ba] + (-> ba + java.io.ByteArrayInputStream. + java.io.BufferedInputStream. + DataInputStream.)) + +(defn str->in ^DataInputStream [^String s] (ba->in (.getBytes s StandardCharsets/UTF_8))) + +(defmacro with-out + "Body -> bytes" + [& body] + `(let [baos# (java.io.ByteArrayOutputStream.) + ~'out (java.io.BufferedOutputStream. baos#)] + (do ~@body) + (.flush ~'out) + (.toByteArray baos#))) + +(defmacro with-out->str [& body] `(enc/utf8-ba->str (with-out ~@body))) +(defmacro with-out->in [& body] `(ba->in (with-out ~@body))) + +(defn xseq->ba ^bytes [with-crlfs? xseq] + (with-out + (doseq [x xseq] + (enc/cond! + (enc/bytes? x) (.write out ^bytes x) + (string? x) (.write out (enc/str->utf8-ba x)) + (int? x) (.write out (enc/str->utf8-ba (str x))) + (char? x) (.write out (int x)) + (vector? x) (.write out (byte-array (mapv byte x)))) + + (when with-crlfs? + (.write out ^bytes ba-crlf))))) + +(do ; Variations useful for tests, etc. + (defn xs->in+ ^DataInputStream [& xs] (ba->in (xseq->ba true xs))) + (defn xs->in ^DataInputStream [& xs] (ba->in (xseq->ba false xs))) + (defn xs->ba+ ^bytes [& xs] (xseq->ba true xs)) + (defn xs->ba ^bytes [& xs] (xseq->ba false xs))) + +(defn skip1 ^DataInputStream [^DataInputStream in] (.skipBytes in 1) in) + +;;;; Blob markers + +(do + (def ba-npy (enc/str->utf8-ba "\u0000>")) + (def ba-bin (enc/str->utf8-ba "\u0000<")) + (def ba-nil (enc/str->utf8-ba "\u0000_"))) + +(defn read-blob-?marker + "Returns e/o {nil :nil :bin :npy}, and possibly advances position + in stream to skip (consume) any blob markers (`ba-npy`, etc.). + Won't be called if `*auto-thaw?*` is false." + [^DataInputStream in ^long n] + (when (>= n 2) ; >= 2 for marker+?payload + (.mark in 2) + (if-not (== (.readByte in) 0) ; Possible marker iff 1st byte null + (do (.reset in) nil) + (enc/case-eval (.readByte in) ; 2nd byte would identify marker kind + (int \_) :nil ; ba-nil + (int \>) :npy ; ba-npy + (int \<) ; ba-bin + (enc/cond + (not core/*issue-83-workaround?*) :bin + (< n 7) :bin ; >= +5 for Nippy payload (4 header + data) + :do (.mark in 3) + (not (== (.readByte in) #=(int \N))) (do (.reset in) :bin) + (not (== (.readByte in) #=(int \P))) (do (.reset in) :bin) + (not (== (.readByte in) #=(int \Y))) (do (.reset in) :bin) + :else (do (.reset in) :npy)) + + ;; :else + (do (.reset in) nil))))) + +;; TODO Add `parse-?marked-ba` -> [ ] user util + +;;;; Errors + +(defn throw! [x] (throw (ex-info "Simulated throw" {:arg (enc/typed-val x)}))) + +(defn reply-error + "Returns a exception that's an instance of both `ExceptionInfo` and `ReplyError`. + Useful for distinguishing reply errors generated by Carmine/Redis, and errors + possibly serialized as user data." + ([msg data cause] (proxy [ExceptionInfo ReplyError] [msg data cause])) + ([msg data ] (proxy [ExceptionInfo ReplyError] [msg data])) + ([ex] + (if-let [cause (enc/ex-cause ex)] + (proxy [ExceptionInfo ReplyError] [(enc/ex-message ex) (or (ex-data ex) {}) cause]) + (proxy [ExceptionInfo ReplyError] [(enc/ex-message ex) (or (ex-data ex) {})])))) + +(comment + (instance? ExceptionInfo (reply-error "msg" {})) + (instance? ReplyError (reply-error "msg" {}))) + +(defn ^:public reply-error? + "Returns true iff given argument is an `ExceptionInfo` generated by Carmine + to indicate a Redis reply error. + + Useful to distinguish between reply errors generated by Carmine/Redis, + and errors possibly serialized as user data. + + If `ex-data-submap` is provided, it must also be a submap of the + exception's `ex-data`: + (reply-error? {:eid :carmine.read/parser-error} my-error)" + ([ x] (instance? ReplyError x)) + ([ex-data-submap x] + (and + (instance? ReplyError x) + (enc/submap? (ex-data x) ex-data-submap)))) + +;;;; Stream discards + +(let [ref-b (int \;)] + (defn discard-stream-separator + [^DataInputStream in] + ;; (.skip 1) + (let [read-b (.readByte in)] ; -1 if nothing to read + (if (== ref-b read-b) + true + (throw + (ex-info "[Carmine] Missing stream separator" + {:eid :carmine.read/missing-stream-separator + :read {:as-byte read-b :as-char (char read-b)}})))))) + +(defn discard-crlf + [^DataInputStream in] + ;; (.skip 2) + (let [s (.readLine in)] ; nil if nothing to read + (if (= s "") + true + (throw + (ex-info "[Carmine] Missing CRLF" + {:eid :carmine.read/missing-crlf + :read s}))))) + +;;;; Sentinels +;; We avoid keywords for flow control due to risk of malicious user data + +(do + (defonce sentinel-null-reply (Object.)) + (defonce sentinel-skipped-reply (Object.)) + (defonce sentinel-end-of-aggregate-stream (Object.))) + +;;;; Read mode + +(def ^:dynamic *read-mode* + "Special read mode, e/o {nil :skip :bytes }. + Applies mostly to blobs, except notably `:skip`." + nil) + +(defmacro ^:public skip-replies + "Establishes special read mode that discards any Redis replies + to requests in body." + [& body] `(binding [*read-mode* :skip] ~@body)) + +(defmacro ^:public normal-replies + "Cancels any active special read mode for body." + [& body] + `(if *read-mode* + (do ~@body) ; Common case optmization + (binding [*read-mode* nil] ~@body))) + +(defmacro ^:public as-bytes + "Establishes special read mode that returns raw byte arrays + for any blob-type Redis replies to requests in body." + [& body] `(binding [*read-mode* :bytes] ~@body)) + +(defmacro ^:public as-thawed + "Establishes special read mode that will attempt Nippy thawing + for any blob-type Redis replies to requests in body." + [thaw-opts & body] `(binding [*read-mode* (AsThawed. ~thaw-opts)] ~@body)) + +(deftype AsThawed [thaw-opts]) +(defn read-mode->?thaw-opts [read-mode] + (when (instance? AsThawed read-mode) + (or (.-thaw-opts ^AsThawed read-mode) {}))) + +(def ^:dynamic *natural-reads?* false) + +(defmacro ^:public natural-reads + "Cancels any active special read mode or reply parser for body. + Equivalent to (unparsed (normal-replies ))." + [& body] `(binding [*natural-reads?* true] ~@body)) + +;;;; ReadOpts, etc. + +(deftype ReadOpts [read-mode parser auto-thaw? keywordize-maps?]) + +(do + (enc/defonce read-opts-natural "For \"natural\" reads" (ReadOpts. nil nil nil nil)) + (enc/defonce read-opts-skip "For `:skip` read mode" (ReadOpts. :skip nil nil nil)) + (enc/defonce read-opts-default "For REPL/tests/etc." (ReadOpts. nil nil true true))) + +(defn in-aggregate-read-opts + "Returns `ReadOpts` for internal reading by aggregates. + We retain (nest) all options but parser." + ^ReadOpts [^ReadOpts read-opts] + (ReadOpts. + (.-read-mode read-opts) + #_(.-parser read-opts) nil + (.-auto-thaw? read-opts) + (.-keywordize-maps? read-opts))) + +(declare ^:dynamic *parser* get-parser-opts) + +(let [read-opts-natural read-opts-natural + read-opts-skip read-opts-skip] + + (defn get-read-opts + "Returns an appropriate `ReadOpts`." + (^ReadOpts [] + (if *natural-reads?* + read-opts-natural + + (let [read-mode *read-mode*] + (if (identical? read-mode :skip) + read-opts-skip ; Optimization, all else irrelevant + + (let [parser *parser*] + ;; Advanced/undocumented: allow parser-opts to influence + ;; dynamic ReadOpts. This is exactly equivalent to + ;; (parse <...> (establish-bindings <...>)). + (if-let [p-opts (get-parser-opts parser)] + (ReadOpts. + (get p-opts :read-mode read-mode) + parser + (if (contains? p-opts :auto-thaw?) (get p-opts :auto-thaw?) core/*auto-thaw?*) + (if (contains? p-opts :keywordize-maps?) (get p-opts :keywordize-maps?) core/*keywordize-maps?*)) + + ;; Common case (no parser-opts present) + (ReadOpts. read-mode parser + core/*auto-thaw?* + core/*keywordize-maps?*))))))) + + (^ReadOpts [opts] ; For REPL/tests + (if (empty? opts) + read-opts-natural + (let [{:keys [read-mode parser auto-thaw? keywordize-maps?]} opts] + (ReadOpts. read-mode parser auto-thaw? keywordize-maps?)))))) + +(comment (enc/qb 1e6 (get-read-opts))) ; 43.72 + +(declare describe-parser) + +(defn describe-read-opts + "For error messages, etc." + [read-opts] + (when-let [^ReadOpts read-opts read-opts] + {:read-mode (.-read-mode read-opts) + :parser (-> (.-parser read-opts) describe-parser) + :auto-thaw? (.-auto-thaw? read-opts) + :keywordize-maps? (.-keywordize-maps? read-opts)})) + +;;;; Reply parsing +;; We choose to keep parsing pretty simple: +;; no nesting, no auto composition, and no concurrent fn+rf parsers. +;; Note that *read-mode* and *parser* are distinct, and may interact. + +(def ^:dynamic *parser* "?" nil) + +(deftype Parser [kind opts f rfc kv-rf?]) +;; rfc: auto-generated (fn rf-constructor []) => +;; parser-opts: +;; read-mode ; nx ; Currently undocumented +;; auto-thaw? ; nx ; '' +;; keywordize-maps? ; nx ; '' +;; kv-rf? ; false ; '' +;; catch-errors? ; true ; '' +;; parse-error-replies? ; false +;; parse-null-replies? ; false + +(defn parser? [x] (instance? Parser x)) +(defn when-parser [x] (when (instance? Parser x) x)) +(defn when-fn-parser [x] (when (and (instance? Parser x) (.-f ^Parser x)) x)) +(defn when-rf-parser [x] (when (and (instance? Parser x) (.-rfc ^Parser x)) x)) +(defn- get-parser-opts [x] (when (instance? Parser x) (.-opts ^Parser x))) + +(defn- describe-parser + "For error messages, etc." + [parser] + (when-let [p ^Parser parser] + {:opts (.-opts p) + :kind (.-kind p) + :kv-rf? (.-kv-rf? p)})) + +(comment + [(describe-parser (fn-parser {:o :O} (fn []))) + (describe-parser (rf-parser {:o :O} nil (fn [])))]) + +(defn- parser-error + [cause data] + (reply-error + "[Carmine] Reply parser threw an error" + (enc/assoc-nx data :eid :carmine.read/parser-error) + cause)) + +(defn- safe-parser-fn [parser-opts f] + (fn safe-parser-fn [x] + (try + (f x) + (catch Throwable t + (parser-error t + {:kind :fn + :parser-opts parser-opts + :arg (enc/typed-val x)}))))) + +(defn fn-parser ^Parser [parser-opts f] + (let [parser-opts (not-empty parser-opts) + f* + (if (get parser-opts :catch-errors? true) + (safe-parser-fn parser-opts f) + (do f))] + (Parser. :fn parser-opts f* nil nil))) + +(defn- safe-parser-xrf + "Returns a stateful transducer to catch any thrown errors in rf. All + future calls to rf will noop and return that same error. Protects + reductions from interruption due to parser errors." + ([ error-data] (safe-parser-xrf (volatile! nil) error-data)) + ([caught_ error-data] + (fn [rf] + (enc/catching-rf + (fn error-fn [extra-data cause] (vreset! caught_ (parser-error cause (conj error-data extra-data)))) + (fn + ([] (or @caught_ (rf))) + ([acc] (or @caught_ (rf acc))) + ([acc in] (or @caught_ (rf acc in))) + ([acc k v] (or @caught_ (rf acc k v)))))))) + +(defn rf-parser + "rf should a reducing fn such that: + (rf) => Init acc + (rf acc in) => Next acc (accumulation step) + (rf acc) => Complete acc" + ^Parser [parser-opts ?xform rf] + (let [parser-opts (not-empty parser-opts) + kv-rf? (if ?xform false (get parser-opts :kv-rf? false)) + + error-data + (fn [thrown-by] + {:parser-opts parser-opts + :xform ?xform + :rf rf + :thrown-by thrown-by}) + + ?xform + (if (get parser-opts :catch-errors? true) + + ;; Catch errors + (let [caught_ (volatile! nil)] + (if-let [xform ?xform] + ;; Currently do double wrapping to distinguish + ;; between :rf and :xform errors + (comp + (safe-parser-xrf caught_ (error-data :xform)) + xform + (safe-parser-xrf caught_ (error-data :rf))) + + (safe-parser-xrf caught_ (error-data :rf)))) + + ;; Don't catch errors + ?xform) + + rf-constructor + (if-let [xform ?xform] + (fn rfc [] (xform rf)) ; Possibly stateful + (fn rfc [] rf))] + + (Parser. :rf parser-opts nil + rf-constructor kv-rf?))) + +(comment (enc/qb 1e6 (rf-parser {} nil (fn [])))) ; 72.61 + +(defn ^:public completing-rf + "Like `completing` for parser reducing fn" + ([rf init ] (completing-rf rf init identity)) + ([rf init cf] + (fn + ([] init) + ([acc] (cf acc)) + ([acc in] (rf acc in)) + ([acc k v] (rf acc k v))))) + +(comment ((crf conj :init))) + +(enc/defalias crf completing-rf) + +;;;; Reply parsing public API + +(defmacro ^:public unparsed + "Cancels any active reply parsers for body. + See also `parse`, `parse-aggregates`." + [& body] `(binding [*parser* nil] ~@body)) + +(defmacro ^:public parse + "Establishes given reply parser for body, + (fn parse-reply [reply]) => . + + When reply is an aggregate, parser will be applied + to the entire aggregate as a single argument + (vec/set/map). + + Only one parser can be active at a time. + No parsing will occur *within* aggregates. + + Parser opts include: + `:parse-error-replies?` (default false) + `:parse-null-replies?` (default false) + + Argument to parser may be affected by special read + modes (`as-bytes`, etc.). + + See also `unparsed`, `parse-aggregates`." + [opts f & body] + `(binding [*parser* (fn-parser ~opts ~f)] + ~@body)) + +(defmacro ^:public parse-aggregates + "Advanced feature. + + Establishes given aggregate reply parser for body. + Expects `rf`, a reducing fn such that: + (rf) => Init acc ; e.g. (transient []) + (rf acc in) => Next acc ; e.g. conj! + (rf acc) => Complete acc ; e.g. persistent! + + This `rf` will be used to parse the elements of any + aggregate replies in a highly efficient way. + + A transducer `xform` may be provided, or nil. + + Only one parser can be active at a time. + Non-aggregate replies will be unaffected. + Nested aggregate replies will be unaffected. + + Parser opts include: + `:parse-null-replies?` (default false) + + Argument to parser may be affected by special read + modes (`as-bytes`, etc.). + + See also `unparsed`, `parse`, `completing-rf`." + [opts ?xform rf & body] + `(binding [*parser* (rf-parser ~opts ~?xform ~rf)] + ~@body)) + +(let [opts {:read-mode nil}] ; Sensible assumption? + (def as-?long-parser (fn-parser opts enc/as-?int)) + (def as-?double-parser (fn-parser opts enc/as-?float)) + (def as-?kw-parser (fn-parser opts enc/as-?kw)) + + (def as-long-parser (fn-parser opts enc/as-int)) + (def as-double-parser (fn-parser opts enc/as-float)) + (def as-kw-parser (fn-parser opts enc/as-kw))) + +(do + (defmacro ^:public as-?long [& body] "Establishes reply parser for body: coerce replies to long, or nil." `(binding [*parser* as-?long-parser] ~@body)) + (defmacro ^:public as-?double [& body] "Establishes reply parser for body: coerce replies to double, or nil." `(binding [*parser* as-?double-parser] ~@body)) + (defmacro ^:public as-?kw [& body] "Establishes reply parser for body: coerce replies to keyword, or nil." `(binding [*parser* as-?kw-parser] ~@body)) + + (defmacro ^:public as-long [& body] "Establishes reply parser for body: coerce replies to long, or throw." `(binding [*parser* as-long-parser] ~@body)) + (defmacro ^:public as-double [& body] "Establishes reply parser for body: coerce replies to double, or throw." `(binding [*parser* as-double-parser] ~@body)) + (defmacro ^:public as-kw [& body] "Estbalishes reply parser for body: coerce replies to keyword, or throw." `(binding [*parser* as-kw-parser] ~@body))) diff --git a/src/taoensso/carmine_v4/resp/read.clj b/src/taoensso/carmine_v4/resp/read.clj new file mode 100644 index 0000000..f2cacc3 --- /dev/null +++ b/src/taoensso/carmine_v4/resp/read.clj @@ -0,0 +1,497 @@ +(ns ^:no-doc taoensso.carmine-v4.resp.read + "Private ns, implementation detail." + (:require + [taoensso.encore :as enc] + [taoensso.nippy :as nippy] + [taoensso.carmine-v4.resp.common :as com + :refer [xs->in+ throw!]]) + + (:import + [java.io DataInputStream] + [taoensso.carmine_v4.resp.common ReadOpts AsThawed Parser])) + +(enc/declare-remote + ^:dynamic taoensso.carmine-v4/*keywordize-maps?* + ^:dynamic taoensso.carmine-v4/*push-fn* + ^:dynamic taoensso.carmine-v4/*issue-83-workaround?*) + +(alias 'core 'taoensso.carmine-v4) + +(comment (remove-ns 'taoensso.carmine-v4.resp.read)) + +;;;; + +(declare + ^:private read-streaming-blob + ^:private read-marked-blob + + ^:private blob->thawed + ^:private blob->parsed-as-?bytes + ^:private blob->parsed-as-?str + ^:private complete-blob) + +(defn- read-blob + "$\r\n\r\n -> ?" + [read-mode read-markers? ^DataInputStream in] + (let [size-str (.readLine in)] + + (if-let [stream? (= size-str "?")] + ;; Streaming + (read-streaming-blob read-mode in) + + ;; Not streaming + (let [n (Integer/parseInt size-str)] + (if (<= n 0) ; Empty or RESP2 null + (if (== n 0) + (if (identical? read-mode :bytes) (byte-array 0) "") ; Empty + com/sentinel-null-reply) + + ;; Not empty + (if-let [marker (and read-markers? (com/read-blob-?marker in n))] + + ;; Marked + (read-marked-blob read-mode marker n in) + + ;; Unmarked + (if (identical? read-mode :skip) + + ;; Skip + (do + (.skipBytes in n) + (com/discard-crlf in) + com/sentinel-skipped-reply) + + ;; Don't skip + (let [ba (byte-array n)] + (.readFully in ba 0 n) + (com/discard-crlf in) + (complete-blob read-mode ba))))))))) + +(let [discard-stream-separator com/discard-stream-separator + discard-crlf com/discard-crlf] + + (defn- read-streaming-blob + [read-mode ^DataInputStream in] + + (if (identical? read-mode :skip) + + ;; Skip + (loop [] + (discard-stream-separator in) + (let [n (Integer/parseInt (.readLine in))] + (if (== n 0) + com/sentinel-skipped-reply ; Stream complete + + ;; Stream continues + (do + (.skipBytes in n) + (discard-crlf in) + (recur))))) + + ;; Don't skip + ;; Even if the final output is a String, it's faster + ;; to accumulate to BAOS then transform to a String at the + ;; end rather than use a StringBuffer. + (let [baos (java.io.ByteArrayOutputStream. 128)] + (loop [] + (discard-stream-separator in) + (let [n (Integer/parseInt (.readLine in))] + (if (== n 0) + + ;; Stream complete + (complete-blob read-mode (.toByteArray baos)) + + ;; Stream continues + (let [ba (byte-array n)] + (.readFully in ba 0 n) + (discard-crlf in) + (.write baos ba 0 (alength ba)) + (recur))))))))) + +(defn- read-marked-blob + [read-mode marker marked-size ^DataInputStream in] + (let [n (- ^int marked-size 2) + ?ba + (when (pos? n) + (let [ba (byte-array n)] + (.readFully in ba 0 n) + (do ba)))] + + (com/discard-crlf in) + (case marker + :nil nil + :bin (or ?ba (byte-array 0)) + :npy + (let [?thaw-opts (com/read-mode->?thaw-opts read-mode)] + ;; ?ba should be nnil when marked + (blob->thawed ?thaw-opts ?ba))))) + +;;;; Read-mode handling + +(defn- blob->thawed [?thaw-opts ba] + (try + (nippy/thaw ba ?thaw-opts) + (catch Throwable t + (com/reply-error + "[Carmine] Nippy threw an error while thawing blob reply" + (enc/assoc-when + {:eid :carmine.read.blob/nippy-thaw-error + :thaw-opts ?thaw-opts + :bytes {:length (count ba) :content ba}} + :possible-non-nippy-bytes? core/*issue-83-workaround?*) + t)))) + +(defn- complete-blob [read-mode ba] + (enc/cond! + (identical? read-mode nil) (enc/utf8-ba->str ba) ; Common case + (identical? read-mode :bytes) ba + + ;; Shouldn't be here at all in this case + ;; (identical? read-mode :skip) read-com/sentinel-skipped-reply + + :if-let [thaw-opts (com/read-mode->?thaw-opts read-mode)] + (blob->thawed thaw-opts ba))) + +;;;; Aggregates + +(defn- read-basic-reply + "Basic version of `read-reply`, useful for testing" + [_read-opts ^DataInputStream in] + (let [kind-b (.readByte in)] + (enc/case-eval kind-b + (int \+) (.readLine in) ; Simple string + (int \:) (Long/parseLong (.readLine in)) ; Simple long + (int \.) + (do + (com/discard-crlf in) + com/sentinel-end-of-aggregate-stream)))) + +(let [sentinel-end-of-aggregate-stream com/sentinel-end-of-aggregate-stream] + (defn- read-aggregate-by-ones + [to ^ReadOpts read-opts read-reply ^DataInputStream in] + (let [size-str (.readLine in) + inner-read-opts (com/in-aggregate-read-opts read-opts) + skip? (identical? (.-read-mode read-opts) :skip)] + + (if-let [stream? (= size-str "?")] + + ;; Streaming + (enc/cond + skip? + (loop [] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + com/sentinel-skipped-reply + (recur)))) + + ;; Reducing parser + :if-let [^Parser p (com/when-rf-parser (.-parser read-opts))] + (let [rf ((.rfc p)) + init-acc (rf)] + (loop [acc init-acc] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + (do (rf acc)) ; Complete acc + (recur (rf acc x)))))) + + :default + (loop [acc (transient (empty to))] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + (persistent! acc) + (recur (conj! acc x)))))) + + ;; Not streaming + (let [n (Integer/parseInt size-str)] + (if (<= n 0) ; Empty or RESP2 null + (if (== n 0) to com/sentinel-null-reply) + + (enc/cond + skip? (enc/reduce-n (fn [_ _] (read-reply inner-read-opts in)) 0 n) + + ;; Reducing parser + :if-let [^Parser p (com/when-rf-parser (.-parser read-opts))] + (let [rf ((.-rfc p)) + init-acc (rf)] + (rf ; Complete acc + (enc/reduce-n + (fn [acc _n] + (rf acc (read-reply inner-read-opts in))) + init-acc + n))) + + :default + (enc/repeatedly-into to n + #(read-reply inner-read-opts in))))))))) + +(let [keywordize (fn [x] (if (string? x) (keyword x) x)) + sentinel-end-of-aggregate-stream com/sentinel-end-of-aggregate-stream] + + (defn- read-aggregate-by-pairs + "Like `read-aggregate-by-ones` but optimized for read-pair + cases (notably maps)." + [^ReadOpts read-opts read-reply ^DataInputStream in] + (let [size-str (.readLine in) + inner-read-opts (com/in-aggregate-read-opts read-opts) + skip? (identical? (.-read-mode read-opts) :skip)] + + (if-let [stream? (= size-str "?")] + + ;; Streaming + (enc/cond + skip? + (loop [] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + com/sentinel-skipped-reply + (let [_k x + _v (read-reply inner-read-opts in)] + (recur))))) + + ;; Reducing parser + :if-let [^Parser p (com/when-rf-parser (.-parser read-opts))] + (let [rf ((.-rfc p)) + kv-rf? (.-kv-rf? p) + init-acc (rf)] + + (loop [acc init-acc] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + (rf acc) ; Complete acc + (let [k x ; Without kfn! + v (read-reply inner-read-opts in)] + (recur + (if kv-rf? + (rf acc k v) + (rf acc (clojure.lang.MapEntry/create k v))))))))) + + :let [kfn (if (.-keywordize-maps? read-opts) keywordize identity)] + :default + (loop [acc (transient {})] + (let [x (read-reply inner-read-opts in)] + (if (identical? x sentinel-end-of-aggregate-stream) + (persistent! acc) + (let [k (kfn x) + v (read-reply inner-read-opts in)] + (recur (assoc! acc k v))))))) + + ;; Not streaming + (let [n (Integer/parseInt size-str)] + (if (<= n 0) ; Empty or RESP2 null + (if (== n 0) {} com/sentinel-null-reply) + + (enc/cond + skip? + (enc/reduce-n + (fn [_ _] + (let [_k (read-reply inner-read-opts in) + _v (read-reply inner-read-opts in)] + nil)) + 0 n) + + ;; Reducing parser + :if-let [^Parser p (com/when-rf-parser (.-parser read-opts))] + (let [rf ((.-rfc p)) + kv-rf? (.-kv-rf? p) + init-acc (rf)] + (rf ; Complete + (enc/reduce-n + (fn [acc _n] + (let [k (read-reply inner-read-opts in) ; Without kfn! + v (read-reply inner-read-opts in)] + (if kv-rf? + (rf acc k v) + (rf acc (clojure.lang.MapEntry/create k v))))) + init-acc + n))) + + :let [kfn (if (.-keywordize-maps? read-opts) keywordize identity)] + :default + (if (> n 10) + (persistent! + (enc/reduce-n + (fn [m _] + (let [k (kfn (read-reply inner-read-opts in)) + v (read-reply inner-read-opts in)] + (assoc! m k v))) + (transient {}) + n)) + + (enc/reduce-n + (fn [m _] + (let [k (kfn (read-reply inner-read-opts in)) + v (read-reply inner-read-opts in)] + (assoc m k v))) + {} + n))))))))) + +(defn- redis-reply-error [?message] + (let [^String message (if (nil? ?message) "" ?message) + code (re-find #"^\S+" message)] ; "ERR", "WRONGTYPE", etc. + + (com/reply-error "[Carmine] Redis replied with an error" + {:eid :carmine.read/error-reply + :message message + :code code}))) + +(comment (redis-reply-error "ERR Foo bar")) + +(declare complete-reply) + +(let [sentinel-end-of-aggregate-stream com/sentinel-end-of-aggregate-stream + sentinel-null-reply com/sentinel-null-reply] + + (defn read-reply + "Blocks to read reply from given DataInputStream. + Returns completed reply." + + ;; For REPL/testing + ([in] (read-reply (com/get-read-opts) in)) + + ([^ReadOpts read-opts ^DataInputStream in] + ;; Since dynamic vars are ephemeral and reply reading is lazy, neither this + ;; fn nor any of its children should use dynamic vars. Instead, we'll capture + ;; dynamic config to `com/ReadOpts` at the appropriate time. + (let [kind-b (.readByte in) + skip? (identical? (.-read-mode read-opts) :skip) + + reply + (try + (enc/case-eval kind-b + ;; --- RESP2 ⊂ RESP3 ------------------------------------------------------- + (int \+) (.readLine in) ; Simple string ✓ + (int \:) ; Simple long ✓ + (let [s (.readLine in)] + (when-not skip? + (Long/parseLong s))) + + (int \-) ; Simple error ✓ + (let [s (.readLine in)] + (when-not skip? + (redis-reply-error s))) + + (int \$) ; Blob (nil/string/bytes/thawed) ✓ + (read-blob + ;; User blob => obey read-opts + (.-read-mode read-opts) + (.-auto-thaw? read-opts) + in) + + (int \*) ; Aggregate array ✓ + (read-aggregate-by-ones [] read-opts + read-reply in) + + ;; --- RESP3 ∖ RESP2 ------------------------------------------------------- + (int \.) (do (com/discard-crlf in) sentinel-end-of-aggregate-stream) ; ✓ + (int \_) (do (com/discard-crlf in) sentinel-null-reply) ; ✓ + + (int \#) ; Bool ✓ + (let [b (.readByte in)] + (com/discard-crlf in) + (== b #=(int \t))) + + (int \!) ; Blob error ✓ + (let [;; Nb cancel read-mode, markers + blob-reply (read-blob nil false in)] + (when-not skip? + (redis-reply-error blob-reply) )) + + (int \=) ; Verbatim string ; ✓ + (let [;; Nb cancel read-mode, markers + ^String s (read-blob nil false in)] + (when-not skip? + (let [format (subs s 0 3) ; "txt", "mkd", etc. + payload (subs s 4)] + ;; TODO API okay? Dynamic opt to just return payload? + [:carmine/verbatim-string format payload]))) + + (int \,) ; Double ✓ + (let [s (.readLine in)] + (when-not skip? + (enc/cond + (= s "inf") Double/POSITIVE_INFINITY + (= s "-inf") Double/NEGATIVE_INFINITY + :else (Double/parseDouble s)))) + + (int \() ; Big integer ✓ + (let [s (.readLine in)] + (when-not skip? + (bigint (BigInteger. s)))) + + (int \~) (read-aggregate-by-ones #{} read-opts read-reply in) ; Aggregate set ✓ + (int \%) (read-aggregate-by-pairs read-opts read-reply in) ; Aggregate map ✓ + + (int \|) ; Attribute map ✓ + (let [attrs (read-aggregate-by-pairs read-opts read-reply in) + target (read-reply read-opts in)] + + (when-not skip? + ;; TODO API okay? + (if (instance? clojure.lang.IObj target) + (with-meta target {:carmine/attributes attrs}) + [:carmine/with-attributes target attrs] + #_ + (throw + (ex-info "[Carmine] Attributes reply for unexpected (non-IObj) type" + {:eid :carmine.read/attributes-for-unexpected-type + :target (enc/typed-val target) + :attributes attrs}))))) + + (int \>) ; Push ✓ + (let [v (read-aggregate-by-ones [] com/read-opts-natural read-reply in)] + (when-let [push-fn core/*push-fn*] ; Not part of read-opts, reasonable? + (try ; Silently swallow errors (fn should have own error handling) + (push-fn v) + (catch Throwable _))) + + ;; Continue to actual reply + (read-reply read-opts in)) + + (throw + (ex-info "[Carmine] Unexpected reply kind" + {:eid :carmine.read/unexpected-reply-kind + :read-opts (com/describe-read-opts read-opts) + :kind + (enc/assoc-when + {:as-byte kind-b :as-char (byte kind-b)} + :end-of-stream? (== kind-b -1))}))) + + (catch Throwable t + (com/reply-error "[Carmine] Unexpected reply error" + {:eid :carmine.read/reply-error + :read-opts (com/describe-read-opts read-opts) + :kind {:as-byte kind-b :as-char (char kind-b)}} + t)))] + + (complete-reply read-opts reply))))) + +(let [sentinel-end-of-aggregate-stream com/sentinel-end-of-aggregate-stream + sentinel-null-reply com/sentinel-null-reply] + + (defn complete-reply [^ReadOpts read-opts reply] + (let [skip? (identical? (.-read-mode read-opts) :skip)] + (enc/cond + skip? + (if (identical? reply sentinel-end-of-aggregate-stream) + reply ; Always pass through + com/sentinel-skipped-reply) + + :if-let [^Parser p (com/when-fn-parser (.-parser read-opts))] + (enc/cond + (com/reply-error? reply) + (if (get (.-opts p) :parse-error-replies?) + ((.-f p) reply) + (do reply)) + + (identical? reply sentinel-null-reply) + (if (get (.-opts p) :parse-null-replies?) + ((.-f p) nil) + (do nil)) + + :default + ((.-f p) reply)) + + :default + (if (identical? reply sentinel-null-reply) + nil + reply))))) diff --git a/src/taoensso/carmine_v4/resp/write.clj b/src/taoensso/carmine_v4/resp/write.clj new file mode 100644 index 0000000..9196c5f --- /dev/null +++ b/src/taoensso/carmine_v4/resp/write.clj @@ -0,0 +1,342 @@ +(ns ^:no-doc taoensso.carmine-v4.resp.write + "Private ns, implementation detail." + (:require + [taoensso.encore :as enc] + [taoensso.nippy :as nippy] + [taoensso.carmine-v4.resp.common :as com + :refer [with-out with-out->str]]) + + (:import + [java.nio.charset StandardCharsets] + [java.io BufferedOutputStream])) + +(enc/declare-remote + ^:dynamic taoensso.carmine-v4/*auto-freeze?* + ^:dynamic taoensso.carmine-v4/*freeze-opts*) + +(alias 'core 'taoensso.carmine-v4) + +(comment (remove-ns 'taoensso.carmine-v4.resp.write)) + +;;;; Bulk byte strings + +(do + (def ^:const min-num-to-cache (long Short/MIN_VALUE)) + (def ^:const max-num-to-cache (long Short/MAX_VALUE))) + +;; Cache ba representation of common number bulks, etc. +(let [long->bytes (fn [n] (.getBytes (Long/toString n) StandardCharsets/UTF_8)) + create-cache ; { ((fn [n])->ba)} + (fn [n-cast from-n to-n f] + (java.util.concurrent.ConcurrentHashMap. ^java.util.Map + (persistent! + (enc/reduce-n + (fn [m n] (let [n (n-cast n)] (assoc! m n (f n)))) + (transient {}) from-n to-n)))) + + b* (int \*) + b$ (int \$) + ba-crlf com/ba-crlf] + + (let [;; { *} for common lengths + ^java.util.concurrent.ConcurrentHashMap cache + (create-cache long 0 256 + (fn [n] + (let [n-as-ba (long->bytes n)] + (com/xs->ba \* n-as-ba "\r\n"))))] + + (defn write-array-len + [^BufferedOutputStream out n] + (let [n (long n)] + (if-let [^bytes cached-ba (.get cache n)] + (.write out cached-ba 0 (alength cached-ba)) + + (let [^bytes n-as-ba (long->bytes n)] + (.write out b*) + (.write out n-as-ba 0 (alength n-as-ba)) + (.write out ba-crlf 0 2)))))) + + (let [;; { $} for common lengths + ^java.util.concurrent.ConcurrentHashMap cache + (create-cache long 0 256 + (fn [n] + (let [n-as-ba (long->bytes n)] + (com/xs->ba \$ n-as-ba "\r\n"))))] + + (defn- write-bulk-len + [^BufferedOutputStream out n] + (let [n (long n)] + (if-let [^bytes cached-ba (.get cache n)] + (.write out cached-ba 0 (alength cached-ba)) + + (let [^bytes n-as-ba (long->bytes n)] + (.write out b$) + (.write out n-as-ba 0 (alength n-as-ba)) + (.write out ba-crlf 0 2)))))) + + (let [b-colon (int \:) + ;; { :} for common longs + ^java.util.concurrent.ConcurrentHashMap cache + (create-cache long min-num-to-cache (inc max-num-to-cache) + (fn [n] (com/xs->ba \: (long->bytes n) "\r\n")))] + + (defn- write-simple-long + [^BufferedOutputStream out n] + (let [n (long n)] + (if-let [^bytes cached-ba (.get cache n)] + (.write out cached-ba 0 (alength cached-ba)) + + (let [^bytes n-as-ba (long->bytes n) + len (alength n-as-ba) + ^bytes len-as-ba (long->bytes len)] + + (.write out b-colon) + (.write out n-as-ba 0 len) + (.write out ba-crlf 0 2)))))) + + (let [;; { $bytes n) + len (alength n-as-ba) + ^bytes len-as-ba (long->bytes len)] + + (com/xs->ba \$ len-as-ba "\r\n" n-as-ba "\r\n"))))] + + (defn- write-bulk-long + [^BufferedOutputStream out n] + (let [n (long n)] + (if-let [^bytes cached-ba (.get cache n)] + (.write out cached-ba 0 (alength cached-ba)) + + (let [^bytes n-as-ba (long->bytes n) + len (alength n-as-ba) + ^bytes len-as-ba (long->bytes len)] + + (.write out b$) + (.write out len-as-ba 0 (alength len-as-ba)) + (.write out ba-crlf 0 2) + + (.write out n-as-ba 0 len) + (.write out ba-crlf 0 2)))))) + + (let [double->bytes (fn [n] (.getBytes (Double/toString n) StandardCharsets/UTF_8)) + + ;; { $bytes n) + len (alength n-as-ba) + ^bytes len-as-ba (long->bytes len)] + + (com/xs->ba \$ len-as-ba "\r\n" n-as-ba "\r\n"))))] + + (defn- write-bulk-double + [^BufferedOutputStream out n] + (let [n (double n)] + (if-let [^bytes cached-ba (.get cache n)] + (.write out cached-ba 0 (alength cached-ba)) + + (let [^bytes n-as-ba (double->bytes n) + len (alength n-as-ba) + ^bytes len-as-ba (long->bytes len)] + + (.write out b$) + (.write out len-as-ba 0 (alength len-as-ba)) + (.write out ba-crlf 0 2) + + (.write out n-as-ba 0 len) + (.write out ba-crlf 0 2))))))) + +(let [write-bulk-len write-bulk-len + ba-crlf com/ba-crlf] + + (defn- write-bulk-ba + "$" + ([^BufferedOutputStream out ^bytes ba] + (let [len (alength ba)] + (write-bulk-len out len) + (.write out ba 0 len) + (.write out ba-crlf 0 2))) + + ([^BufferedOutputStream out ^bytes ba-marker ^bytes ba-payload] + (let [marker-len (alength ba-marker) + payload-len (alength ba-payload) + total-len (+ marker-len payload-len)] + (write-bulk-len out total-len) + (.write out ba-marker 0 marker-len) + (.write out ba-payload 0 payload-len) + (.write out ba-crlf 0 2))))) + +(defn- reserve-null! + "This is a Carmine (not Redis) limitation to support auto null-prefixed + blob markers with special semantics (`ba-npy`, etc.)." + [^String s] + (when (and (not (.isEmpty s)) (== ^int (.charAt s 0) 0)) + (throw + (ex-info "[Carmine] String args can't begin with null (char 0)" + {:eid :carmine.write/null-reserved + :arg s})))) + +(defn- write-bulk-str [^BufferedOutputStream out s] + (reserve-null! s) + (write-bulk-ba out (enc/str->utf8-ba s))) + +;;;; Wrapper types +;; IRedisArg behaviour influenced by wrapping arguments, wrapping +;; must capture any relevant dynamic config at wrap time. +;; +;; Implementation detail: +;; We try to avoid lazily converting arguments to Redis byte strings +;; (i.e. while writing to out) if there's a chance the conversion +;; could fail (e.g. Nippy freeze). + +(deftype ToBytes [ba]) +(defn ^:public to-bytes + "Wraps given bytes to ensure that they'll be written to Redis + without any modifications (serialization, blob markers, etc.)." + (^ToBytes [ba] + (if (instance? ToBytes ba) + ba + (if (enc/bytes? ba) + (ToBytes. ba) + (throw + (ex-info "[Carmine] `to-bytes` expects a byte-array argument" + {:eid :carmine.write/unsupported-arg-type + :arg (enc/typed-val ba)}))))) + + ;; => Vector for destructuring (undocumented) + ([ba & more] (mapv to-bytes (cons ba more)))) + +(deftype ToFrozen [arg freeze-opts ?frozen-ba]) +(defn ^:public to-frozen + "Wraps given argument to ensure that it'll be written to Redis + using Nippy serialization [1]. + + Options: + See `taoensso.nippy/freeze` for `freeze-opts` docs. + By default, `*freeze-opts*` value will be used. + + See also `as-thawed` for thawing (deserialization). + [1] Ref. " + + (^ToFrozen [ x] (to-frozen core/*freeze-opts* x)) + (^ToFrozen [freeze-opts x] + ;; We do eager freezing here since we can, and we'd prefer to + ;; catch freezing errors early (rather than while writing to out). + (if (instance? ToFrozen x) + (let [^ToFrozen x x] + (if (= freeze-opts (.-freeze-opts x)) + x + (let [arg (.-arg x)] + ;; Re-freeze (expensive) + (ToFrozen. arg freeze-opts + (nippy/freeze arg freeze-opts))))) + + (ToFrozen. x freeze-opts + (nippy/freeze x freeze-opts)))) + + ;; => Vector for destructuring (undocumented) + ([freeze-opts x & more] + (let [freeze-opts + (enc/have [:or nil? map?] + (if (identical? freeze-opts :dynamic) + core/*freeze-opts* + freeze-opts))] + + (mapv #(to-frozen freeze-opts %) (cons x more))))) + +;;;; IRedisArg + +(defprotocol ^:private IRedisArg + "Internal protocol, not for public use or extension." + (write-bulk-arg [x ^BufferedOutputStream out] + "Writes given arbitrary Clojure argument to `out` as a Redis byte string.")) + +(def ^:private bulk-nil + (with-out + (write-bulk-len out 2) + (.write out com/ba-nil 0 2) + (.write out com/ba-crlf 0 2))) + +(comment (enc/utf8-ba->str bulk-nil)) + +(let [write-bulk-str write-bulk-str + ba-bin com/ba-bin + ba-npy com/ba-npy + bulk-nil bulk-nil + bulk-nil-len (alength ^bytes bulk-nil) + kw->str + (fn [kw] + (if-let [ns (namespace kw)] + (str ns "/" (name kw)) + (do (name kw)))) + + non-native-type! + (fn [arg] + (throw + (ex-info "[Carmine] Trying to send argument of non-native type to Redis while `*auto-freeze?` is false" + {:eid :carmine.write/non-native-arg-type + :arg (enc/typed-val arg)})))] + + (extend-protocol IRedisArg + String (write-bulk-arg [s out] (write-bulk-str out s)) + Character (write-bulk-arg [c out] (write-bulk-str out (.toString c))) + clojure.lang.Keyword (write-bulk-arg [kw out] (write-bulk-str out (kw->str kw))) + + ;; Redis doesn't currently seem to accept `write-simple-long` (at least + ;; without RESP3 mode?) though this seems an unnecessary limitation? + Long (write-bulk-arg [n out] (write-bulk-long out n)) + Integer (write-bulk-arg [n out] (write-bulk-long out n)) + Short (write-bulk-arg [n out] (write-bulk-long out n)) + Byte (write-bulk-arg [n out] (write-bulk-long out n)) + Double (write-bulk-arg [n out] (write-bulk-double out n)) + Float (write-bulk-arg [n out] (write-bulk-double out n)) + ToBytes (write-bulk-arg [x out] (write-bulk-ba out (.-ba x))) + ToFrozen + (write-bulk-arg [x out] + (let [ba (or (.-?frozen-ba x) (nippy/freeze x (.-freeze-opts x)))] + (if core/*auto-freeze?* + (write-bulk-ba out ba-npy ba) + (write-bulk-ba out ba)))) + + Object + (write-bulk-arg [x out] + (if core/*auto-freeze?* + (write-bulk-ba out ba-npy (nippy/freeze x)) + (non-native-type! x))) + + nil + (write-bulk-arg [x ^BufferedOutputStream out] + (if core/*auto-freeze?* + (.write out bulk-nil 0 bulk-nil-len) + (non-native-type! x)))) + + (extend-type (Class/forName "[B") ; Extra `extend` needed due to CLJ-1381 + IRedisArg + (write-bulk-arg [ba out] + (if core/*auto-freeze?* + (write-bulk-ba out ba-bin ba) ; Write marked bytes + (write-bulk-ba out ba) ; Write unmarked bytes + )))) + +;;;; + +(defn- write-requests ; Used only for REPL/testing + "Sends pipelined requests to Redis server using its byte string protocol: + * crlf + [$ crlf + crlf ...]" + [^BufferedOutputStream out reqs] + (enc/run! + (fn [req-args] + (let [n-args (count req-args)] + (when-not (== n-args 0) + (write-array-len out n-args) + (enc/run! + (fn [arg] (write-bulk-arg arg out)) + req-args)))) + reqs) + (.flush out)) diff --git a/src/taoensso/carmine_v4/sentinel.clj b/src/taoensso/carmine_v4/sentinel.clj new file mode 100644 index 0000000..79ab337 --- /dev/null +++ b/src/taoensso/carmine_v4/sentinel.clj @@ -0,0 +1,498 @@ +(ns ^:no-doc taoensso.carmine-v4.sentinel + "Private ns, implementation detail. + Implementation of the Redis Sentinel protocol, + Ref. " + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.carmine-v4.utils :as utils] + [taoensso.carmine-v4.conns :as conns] + [taoensso.carmine-v4.resp :as resp] + [taoensso.carmine-v4.opts :as opts]) + + (:import [java.util.concurrent.atomic AtomicLong])) + +(comment (remove-ns 'taoensso.carmine-v4.sentinel)) + +(enc/declare-remote + ^:dynamic taoensso.carmine-v4/*conn-cbs*) + +(alias 'core 'taoensso.carmine-v4) + +;;;; Dev/test config + +(defn- spit-sentinel-test-config + [{:keys [n-sentinels first-sentinel-port master-name master-addr quorum] + :or + {n-sentinels 2 + first-sentinel-port 26379 + master-name "my-master" + master-addr ["127.0.0.1" 6379] + quorum n-sentinels}}] + + (dotimes [idx n-sentinels] + (let [[master-host master-port] master-addr + sentinel-port (+ ^long first-sentinel-port idx) + fname (str "sentinel" (inc idx) ".conf") + + content + (format + "# Redis Sentinel test config generated by Carmine +# Start Sentinel server with `redis-sentinel %1$s` + +port %2$s + +# sentinel monitor +sentinel monitor %3$s %4$s %5$s %6$s +sentinel down-after-milliseconds %3$s 60000" + + fname + sentinel-port + master-name master-host master-port + quorum)] + + (spit fname content )))) + +(comment (spit-sentinel-test-config {})) + +;;;; Node adresses +;; - Node => Redis master, Redis read replica, or Sentinel server +;; - Address => [ ] + +(defn- remove-addr [old-addrs addr] + (let [addr (opts/parse-sock-addr addr)] + (transduce (remove #(= % addr)) conj [] old-addrs))) + +(defn- add-addr->front [old-addrs addr] + (let [addr (opts/parse-sock-addr addr)] + (if (= (get old-addrs 0) addr) + (do old-addrs) + (transduce (remove #(= % addr)) conj [addr] old-addrs)))) + +(defn- add-addrs->back [old-addrs addrs] + (if (empty? addrs) + old-addrs + (let [old-addrs (or old-addrs []) + old-addr? (set old-addrs)] + (transduce (comp (map opts/parse-sock-addr) (remove old-addr?)) + conj old-addrs addrs)))) + +(defn- reset-addrs [addrs] + (transduce (comp (map opts/parse-sock-addr) (distinct)) + conj [] addrs)) + +;;;; SentinelSpec + +(defprotocol ^:private ISentinelSpec + "Internal protocol, not for public use or extension." + (sentinel-opts [spec]) + (update-addrs! [spec master-name cbs kind f]) + (resolve-addr! [spec master-name sentinel-opts use-cache?]) + (resolved-addr? [spec master-name sentinel-opts use-cache? addr])) + +(def ^:dynamic *mgr-cbs* + "Private, implementation detail. + Mechanism to support `ConnManager` callbacks (cbs)." + nil) + +(enc/defn-cached ^:private unique-addrs {:size 128 :gc-every 100} + [addrs-state] + (let [vs (vals addrs-state)] + {:masters (into #{} (map :master) vs) + :replicas (into #{} (comp (map :replicas) cat) vs) + :sentinels (into #{} (comp (map :sentinels) cat) vs)})) + +(let [kvs->map (fn [x] (if (map? x) x (into {} (comp (partition-all 2)) x)))] + (defn- parse-nodes-info->addrs [info-seq] + (when info-seq ; [ ...] + (not-empty + (reduce + (fn [acc in] ; Info elements may be map (RESP3) or kvseq (RESP2) + (let [in (kvs->map in)] + (enc/if-let [host (get in "host") + port (get in "port")] + (conj acc [host port]) + (do acc)))) + [] + info-seq))))) + +(defn- get-rand [coll] (if (empty? coll) nil (get coll (rand-int (count coll))))) +(defn- members= [c1 c2] (or (= c1 c2) (and (= (count c1) (count c2)) (= (set c1) (set c2))))) + +(defn- inc-stat! [stats_ k1 k2] (swap! stats_ (fn [m] (enc/update-in m [k1 k2] (fn [?n] (inc (long (or ?n 0)))))))) +(comment (inc-stat! (atom {}) "foo" :k1)) + +(deftype SentinelSpec + [sentinel-opts + addrs-state_ ; Delayed { {:master , :replicas [s], :sentinels [s]}} + resolve-stats_ ; { {:keys [n-requests n-attempts n-successes n-errors n-resolved-to-X n-changes-to-X]} + sentinel-stats_ ; { {:keys [ n-attempts n-successes n-errors n-ignorant n-unreachable n-misidentified]} + ] + + Object + (toString [this] + ;; "taoensso.carmine.SentinelSpec[masters=3 replicas=4 sentinels=2 0x7b9f6831]" + (let [{:keys [masters replicas sentinels]} (unique-addrs (force @addrs-state_))] + (str + "taoensso.carmine.SentinelSpec[" + "masters=" (count masters) " " + "replicas=" (count replicas) " " + "sentinels=" (count sentinels) " " + (enc/ident-hex-str this) "]"))) + + clojure.lang.IDeref + (deref [this] + (let [addrs-state (force @addrs-state_)] + {:sentinel-opts sentinel-opts + :nodes-addrs addrs-state + :stats + (let [{:keys [masters replicas sentinels]} (unique-addrs addrs-state)] + {:node-counts + {:masters (count masters) + :replicas (count replicas) + :sentinels (count sentinels)} + + :resolve-stats @resolve-stats_ + :sentinel-stats @sentinel-stats_})})) + + ISentinelSpec + (sentinel-opts [_] sentinel-opts) + (update-addrs! [this master-name cbs kind f] + (have? [:el #{:master :replicas :sentinels}] kind) + (let [master-name (enc/as-qname master-name) + master? (identical? kind :master)] + + (if-let [[old-val new-val] + (let [swap-result_ (volatile! nil) + new-state_ + (swap! addrs-state_ + (fn [old-state_] + (delay ; Minimize contention during (sometimes expensive) updates + (let [old-state (force old-state_) + old-val (utils/get-at old-state master-name kind) + new-val (f old-val)] + + (if-let [unchanged? + (if master? + (= old-val new-val) + (members= old-val new-val))] + + old-state + (do + (vreset! swap-result_ [old-val new-val]) + (assoc-in old-state [master-name kind] new-val)))))))] + + @new-state_ + @swap-result_)] + + (let [cbid + (case kind + :master (do (inc-stat! resolve-stats_ master-name :n-changes-to-master) :on-changed-master) + :replicas (do (inc-stat! resolve-stats_ master-name :n-changes-to-replicas) :on-changed-replicas) + :sentinels (do (inc-stat! resolve-stats_ master-name :n-changes-to-sentinels) :on-changed-sentinels))] + + (utils/cb-notify! + (get core/*conn-cbs* cbid) + (get *mgr-cbs* cbid) + (get cbs cbid) + (delay + (assoc + {:cbid cbid + :master-name master-name + :sentinel-spec this + :sentinel-opts sentinel-opts + :changed {:old old-val, :new new-val}}))) + true) + + false))) + + (resolve-addr! [this master-name sentinel-opts use-cache?] + (let [master-name (enc/as-qname master-name) + node-addrs (get @addrs-state_ master-name) + {:keys [prefer-read-replica?]} sentinel-opts] + + (if use-cache? + (or + (when prefer-read-replica? (get-rand (get node-addrs :replicas))) + (do (get node-addrs :master)))) + + (let [t0 (System/currentTimeMillis) + sentinel-addrs (get node-addrs :sentinels) + + {:keys [conn-opts cbs update-replicas? update-sentinels?]} + sentinel-opts] + + (if (empty? sentinel-addrs) + (do + (inc-stat! resolve-stats_ master-name :n-errors) + (utils/cb-notify-and-throw! :on-resolve-error + (get core/*conn-cbs* :on-resolve-error) + (get *mgr-cbs* :on-resolve-error) + (get cbs :on-resolve-error) + (ex-info "[Carmine] [Sentinel] No Sentinel server addresses configured for requested master" + {:eid :carmine.sentinel/no-sentinel-addrs-in-spec + :master-name master-name + :sentinel-spec this + :sentinel-opts sentinel-opts} + (Exception. "No Sentinel server addresses in spec")))) + + (let [n-attempts* (java.util.concurrent.atomic.AtomicLong. 0) + attempt-log_ (volatile! []) ; [ ...] + error-counts_ (volatile! {}) ; { {:keys [unreachable ignorant misidentified]}} + record-error! + (fn [sentinel-addr t0-attempt error-kind ?data] + + (inc-stat! sentinel-stats_ sentinel-addr :n-errors) + (inc-stat! sentinel-stats_ sentinel-addr + (case error-kind + :ignorant :n-ignorant + :unreachable :n-unreachable + :misidentified :n-misidentified + :n-other-errors)) + + ;; Add entry to attempt log + (let [attempt-ms (- (System/currentTimeMillis) ^long t0-attempt)] + (vswap! attempt-log_ conj + (assoc + (conj + {:attempt (.get n-attempts*) + :sentinel-addr sentinel-addr + :error error-kind} + ?data) + :attempt-ms attempt-ms))) + + ;; Increment counter for error kind + (vswap! error-counts_ + (fn [m] + (enc/update-in m [sentinel-addr error-kind] + (fn [?n] (inc (long (or ?n 0)))))))) + + ;; Node addrs reported during resolution + reported-sentinel-addrs_ (volatile! #{}) + reported-replica-addrs_ (volatile! #{}) + + complete-resolve! + (fn + ([error] + (inc-stat! resolve-stats_ master-name :n-errors) + + (when-let [addrs @reported-sentinel-addrs_] + (update-addrs! this master-name cbs :sentinels + (fn [old] (add-addrs->back old addrs)))) + + (utils/cb-notify-and-throw! :on-resolve-error + (get core/*conn-cbs* :on-resolve-error) + (get *mgr-cbs* :on-resolve-error) + (get cbs :on-resolve-error) + error)) + + ([reporting-sentinel-addr resolved-addr confirmed-role] + (let [reporting-sentinel-addr (opts/parse-sock-addr reporting-sentinel-addr) + resolved-addr (opts/parse-sock-addr resolved-addr)] + + (when-let [addrs @reported-replica-addrs_] + (update-addrs! this master-name cbs :replicas + (fn [old] (reset-addrs addrs)))) + + (when-let [addrs @reported-sentinel-addrs_] + (update-addrs! this master-name cbs :sentinels + (fn [old] (add-addrs->back old addrs)))) + + (inc-stat! sentinel-stats_ reporting-sentinel-addr :n-successes) + (inc-stat! resolve-stats_ master-name :n-successes) + (inc-stat! resolve-stats_ master-name + (case confirmed-role + :master :n-resolved-to-master + :replica :n-resolved-to-replica)) + + (utils/cb-notify! + (get core/*conn-cbs* :on-resolve-success) + (get *mgr-cbs* :on-resolve-success) + (get cbs :on-resolve-success) + (delay + {:cbid :on-resolve-success + :master-name master-name + :resolved-to {:addr resolved-addr :role confirmed-role} + :sentinel-spec this + :sentinel-opts sentinel-opts + :ms-elapsed (- (System/currentTimeMillis) t0)})) + + (when (identical? confirmed-role :master) + (update-addrs! this master-name cbs :master + (fn [_old] resolved-addr))) + + resolved-addr)))] + + (loop [n-retries 0] + (let [t0-attempt (System/currentTimeMillis) + [?reporting-sentinel-addr ?reported-master-addr] ; ?[ ] + (reduce + ;; Try each known sentinel addr, sequentially + (fn [acc sentinel-addr] + (.incrementAndGet n-attempts*) + (inc-stat! resolve-stats_ master-name :n-attempts) + (inc-stat! sentinel-stats_ sentinel-addr :n-attempts) + (let [[host port] sentinel-addr + [?master-addr ?replicas-info ?sentinels-info] + (case host ; Simulated errors for tests + "unreachable" [::unreachable nil nil] + "misidentified" [["simulated-misidentified" 0] nil nil] + "ignorant" nil + (try + (conns/with-new-conn conn-opts host port master-name + (fn [_ in out] + (resp/with-replies in out :natural-reads :as-vec + (fn [] + ;; Always ask about master (may be used as fallback when no replicas) + (resp/rcall "SENTINEL" "get-master-addr-by-name" master-name) + + (if (or prefer-read-replica? update-replicas?) + ;; Ask about replica nodes + (resp/rcall "SENTINEL" "replicas" master-name) + (resp/local-echo nil)) + + (when update-sentinels? + ;; Ask about sentinel nodes + (resp/rcall "SENTINEL" "sentinels" master-name)))))) + + (catch Throwable _ + [::unreachable nil nil])))] + + (when-let [addrs (parse-nodes-info->addrs ?replicas-info)] (vreset! reported-replica-addrs_ addrs)) + (when-let [addrs (parse-nodes-info->addrs ?sentinels-info)] (vswap! reported-sentinel-addrs_ into addrs)) + + (enc/cond + (vector? ?master-addr) (reduced [sentinel-addr (opts/parse-sock-addr ?master-addr)]) + (nil? ?master-addr) (do (record-error! sentinel-addr t0-attempt :ignorant nil) acc) + (identical? ?master-addr ::unreachable) (do (record-error! sentinel-addr t0-attempt :unreachable nil) acc)))) + + nil sentinel-addrs)] + + (if-let [[reporting-sentinel-addr resolved-addr confirmed-role] + (enc/when-let [sentinel-addr ?reporting-sentinel-addr + master-addr ?reported-master-addr] + + (let [[target-addr expected-role] + (or + (when prefer-read-replica? + (when-let [replica-addr (get-rand @reported-replica-addrs_)] + [replica-addr :replica])) + + [master-addr :master]) + + actual-role + (let [[host port] target-addr + reply + (try + (conns/with-new-conn conn-opts host port master-name + (fn [_ in out] + (resp/with-replies in out :natural-reads false + (fn [] (resp/rcall "ROLE"))))) + (catch Throwable _ nil))] + + (when (vector? reply) (get reply 0)))] + + ;; Confirm that node and sentinel agree on node's role + (if (= actual-role (name expected-role)) + [sentinel-addr target-addr expected-role] + (do + (record-error! sentinel-addr t0-attempt :misidentified + {:resolved-to + {:addr target-addr + :role {:expected expected-role + :actual (keyword actual-role)}}}) + nil))))] + + (complete-resolve! reporting-sentinel-addr resolved-addr confirmed-role) + + (let [{:keys [resolve-timeout-ms retry-delay-ms]} sentinel-opts + elapsed-ms (- (System/currentTimeMillis) t0) + retry-at-ms (+ elapsed-ms (long (or retry-delay-ms 0)))] + + (if (> retry-at-ms (long (or resolve-timeout-ms 0))) + (do + (vswap! attempt-log_ conj + [:timeout + (str + "(" elapsed-ms " elapsed + " retry-delay-ms " delay = " retry-at-ms + ") > " resolve-timeout-ms " timeout")]) + + (complete-resolve! + (ex-info "[Carmine] [Sentinel] Timed out while trying to resolve requested master" + {:eid :carmine.sentinel/resolve-timeout + :master-name master-name + :sentinel-spec this + :sentinel-opts sentinel-opts + :sentinel-errors @error-counts_ + :n-attempts (.get n-attempts*) + :n-retries n-retries + :ms-elapsed (- (System/currentTimeMillis) t0) + :attempt-log @attempt-log_}))) + (do + (vswap! attempt-log_ conj [:retry-after-sleep retry-delay-ms]) + (Thread/sleep (int retry-delay-ms)) + (recur (inc n-retries))))))))))))) + + (resolved-addr? [this master-name sentinel-opts use-cache? addr] + (when-not use-cache? ; Update cache + (resolve-addr! this master-name sentinel-opts false)) + + (let [addr (opts/parse-sock-addr addr) + master-name (enc/as-qname master-name) + node-addrs (get @addrs-state_ master-name)] + (or + (when (= addr (get node-addrs :master)) :master) + (when (and (get sentinel-opts :prefer-read-replica?) + (enc/rfirst #(= % addr) (get node-addrs :replicas))) + :replica))))) + +(enc/def-print-impl [ss SentinelSpec] (str "#" ss)) + +(defn ^:public sentinel-spec? + "Returns true iff given argument is a Carmine `SentinelSpec`." + [x] (instance? SentinelSpec x)) + +(defn ^:public sentinel-spec + "Given a Redis Sentinel server addresses map of form + { [[ ] ...]}, + returns a new stateful `SentinelSpec` for use in `conn-opts`. + + (def my-sentinel-spec + \"Stateful Redis Sentinel server spec. Will be kept + automatically updated by Carmine.\" + (sentinel-spec + {:caching [[\"192.158.1.38\" 26379] ...] + :message-queue [[\"192.158.1.38\" 26379] ...]})) + => stateful `SentinelSpec` + + For options docs, see `*default-sentinel-opts*` docstring. + See also `get-env` for a util to load `sentinel-addrs-map` + from environmental config." + ([sentinel-addrs-map ] (sentinel-spec sentinel-addrs-map nil)) + ([sentinel-addrs-map sentinel-opts] + (let [addrs-state + (reduce-kv + (fn [m master-name addrs] + (assoc m (enc/as-qname master-name) + {:sentinels (reset-addrs addrs)})) + {} (have map? sentinel-addrs-map))] + + (SentinelSpec. + (have [:or nil? map?] sentinel-opts) + (atom addrs-state) + (atom {}) + (atom {}))))) + +(comment + (resolve-addr! + ;; Use host e/o #{"unreachable" "ignorant" "misidentified"} to simulate errors + (sentinel-spec {"my-master" [[#_"ignorant" #_"misidentified" "127.0.0.1" 26379]]}) + "my-master" {} (not :use-cache)) + + (conns/with-new-conn {} "127.0.0.1" 26379 #_6379 nil + (fn [_ in out] + (resp/with-replies in out false false + (fn [] + (resp/rcall "ROLE") + #_(resp/rcall "SENTINEL" "get-master-addr-by-name" "my-master") + #_(resp/rcall "SENTINEL" "replicas" "my-master") + #_(core/rcall "SENTINEL" "sentinels" "my-master")))))) diff --git a/src/taoensso/carmine_v4/utils.clj b/src/taoensso/carmine_v4/utils.clj new file mode 100644 index 0000000..a1ea424 --- /dev/null +++ b/src/taoensso/carmine_v4/utils.clj @@ -0,0 +1,107 @@ +(ns ^:no-doc taoensso.carmine-v4.utils + "Private ns, implementation detail." + (:require [taoensso.encore :as enc])) + +(comment (remove-ns 'taoensso.carmine-v4.utils)) + +(let [not-found (Object.) + empty? (fn [x] (== (count x) 0)) + merge2 + (fn [left right] + (reduce-kv + (fn rf [rm lk lv] + (let [rv (get rm lk not-found)] + (enc/cond + (identical? rv not-found) (assoc rm lk lv) + (map? rv) + (if (map? lv) + (assoc rm lk (reduce-kv rf rv lv)) + (do rm)) + :else rm))) + right left))] + + (defn merge-opts + "Like `enc/nested-merge`, but optimised for merging opts. + Opt vals are used in ascending order of preference: + `o3` > `o2` > `o1`" + ([ o1] o1) + ([ o1 o2] (if (empty? o2) o1 (merge2 o1 o2))) + ([o1 o2 o3] + (if (empty? o3) + (if (empty? o2) + o1 + (if (empty? o1) + o2 + (merge2 o1 o2))) + + (if (empty? o2) + (if (empty? o1) + o3 + (merge2 o1 o3)) + + (if (empty? o1) + (merge2 o2 o3) + (merge2 (merge2 o1 o2) o3))))))) + +(comment (enc/qb 1e6 (merge-opts {:a 1} {:a 2} {:a 3}))) ; 75.67 + +(defn dissoc-k [m in-k dissoc-k] + (if-let [in-v (get m in-k)] + (if (map? in-v) + (assoc m in-k (dissoc in-v dissoc-k)) + (do m)) + (do m))) + +(defn dissoc-ks [m in-k dissoc-ks] + (if-let [in-v (get m in-k)] + (if (map? in-v) + (assoc m in-k (reduce dissoc in-v dissoc-ks)) + (do m)) + (do m))) + +(defn get-at + "Optimized `get-in`." + ([m k1 ] (when m (get m k1))) + ([m k1 k2 ] (when m (when-let [m2 (get m k1)] (get m2 k2)))) + ([m k1 k2 k3] (when m (when-let [m2 (get m k1)] (when-let [m3 (get m2 k2)] (get m3 k3)))))) + +(defmacro get-first-contained [m & ks] + (when ks + `(if (contains? ~m ~(first ks)) + (get ~m ~(first ks)) + (get-first-contained ~m ~@(next ks))))) + +(comment (clojure.walk/macroexpand-all '(get-first-contained opts :k1 :k2 :k3))) + +;;;; + +(defn cb-notify! + "Notifies callbacks by calling them with @data_." + ([cb data_] (when cb (enc/catching (cb (force data_))))) + ([cb1 cb2 data_] + (when cb1 (enc/catching (cb1 (force data_)))) + (when cb2 (enc/catching (cb2 (force data_))))) + + ([cb1 cb2 cb3 data_] + (when cb1 (enc/catching (cb1 (force data_)))) + (when cb2 (enc/catching (cb2 (force data_)))) + (when cb3 (enc/catching (cb3 (force data_)))))) + +(let [get-data_ + (fn [error cbid] + (let [data (assoc (ex-data error) :cbid cbid) + data + (if-let [cause (or (get data :cause) (enc/ex-cause error))] + (assoc data :cause cause) + (do data))] + (delay data)))] + + (defn cb-notify-and-throw! + "Notifies callbacks with error data, then throws error." + ([cbid cb error] (cb-notify! cb (get-data_ error cbid)) (throw error)) + ([cbid cb1 cb2 error] (cb-notify! cb1 cb2 (get-data_ error cbid)) (throw error)) + ([cbid cb1 cb2 cb3 error] (cb-notify! cb1 cb2 cb3 (get-data_ error cbid)) (throw error)))) + +(comment + (cb-notify-and-throw! :cbid1 println + (ex-info "Error msg" {:x :X} (Exception. "Cause")))) diff --git a/test/taoensso/carmine_v4/tests/main.clj b/test/taoensso/carmine_v4/tests/main.clj new file mode 100644 index 0000000..708ff21 --- /dev/null +++ b/test/taoensso/carmine_v4/tests/main.clj @@ -0,0 +1,271 @@ +(ns taoensso.carmine-v4.tests.main + "High-level Carmine tests. + These need a running Redis server." + (:require + [clojure.test :as test :refer [deftest testing is]] + [taoensso.encore :as enc :refer [throws?]] + [taoensso.carmine :as v3-core] + [taoensso.carmine-v4 :as car :refer [wcar with-replies]] + [taoensso.carmine-v4.resp :as resp] + [taoensso.carmine-v4.utils :as utils] + [taoensso.carmine-v4.opts :as opts] + [taoensso.carmine-v4.conns :as conns] + [taoensso.carmine-v4.sentinel :as sentinel] + [taoensso.carmine-v4.cluster :as cluster])) + +(comment + (remove-ns 'taoensso.carmine-v4.tests.main) + (test/run-tests 'taoensso.carmine-v4.tests.main) + (test/run-all-tests #"taoensso\.carmine-v4.*")) + +;;;; TODO +;; - Interactions between systems (read-opts, parsers, etc.) +;; - Test conns +;; - Callbacks, closing data, etc. +;; - Sentinel, resolve changes + +;;;; Setup, etc. + +(defn tk "Test key" [key] (str "__:carmine:test:" (enc/as-qname key))) +(def tc "Unparsed test conn-opts" {}) +(def tc+ "Parsed test conn-opts" (opts/parse-conn-opts false tc)) + +(defonce mgr_ (delay (conns/conn-manager-pooled {:conn-opts tc}))) + +(let [delete-test-keys + (fn [] + (when-let [ks (seq (wcar mgr_ (resp/rcall "keys" (tk "*"))))] + (wcar mgr_ (doseq [k ks] (resp/rcall "del" k)))))] + + (test/use-fixtures :once + (enc/test-fixtures + {:before delete-test-keys + :after delete-test-keys}))) + +;;;; Utils + +(deftest _merge-opts + [(is (= (utils/merge-opts {:a 1 :b 1} {:a 2}) {:a 2, :b 1})) + (is (= (utils/merge-opts {:a {:a1 1} :b 1} {:a {:a1 2}}) {:a {:a1 2}, :b 1})) + (is (= (utils/merge-opts {:a {:a1 1} :b 1} {:a nil}) {:a nil, :b 1})) + + (is (= (utils/merge-opts {:a 1} {:a 2} {:a 3}) {:a 3})) + + (is (= (utils/merge-opts {:a 1} {:a 2} { }) {:a 2})) + (is (= (utils/merge-opts {:a 1} { } {:a 3}) {:a 3})) + (is (= (utils/merge-opts { } {:a 2} {:a 3}) {:a 3}))]) + +(deftest _dissoc-utils + [(is (= (utils/dissoc-k {:a {:b :B :c :C :d :D}} :a :b) {:a {:c :C, :d :D}})) + (is (= (utils/dissoc-ks {:a {:b :B :c :C :d :D}} :a [:b :d]) {:a {:c :C}}))]) + +(deftest _get-first-contained + [(is (= (let [m {:a :A :b :B}] (utils/get-first-contained m :q :r :a :b)) :A)) + (is (= (let [m {:a false :b :B}] (utils/get-first-contained m :q :r :a :b)) false))]) + +;;;; Opts + +(deftest _sock-addrs + [(is (= (opts/descr-sock-addr (opts/parse-sock-addr "ip" "80")) ["ip" 80 ])) + (is (= (opts/descr-sock-addr (opts/parse-sock-addr ^:my-meta ["ip" "80"])) ["ip" 80 {:my-meta true}]))]) + +(deftest _parse-string-server + [(is (= (#'opts/parse-string-server "redis://user:pass@x.y.com:9475/3") {:server ["x.y.com" 9475], :init {:auth {:username "user", :password "pass"}, :select-db 3}})) + (is (= (#'opts/parse-string-server "redis://:pass@x.y.com.com:9475/3") {:server ["x.y.com.com" 9475], :init {:auth { :password "pass"}, :select-db 3}} )) + (is (= (#'opts/parse-string-server "redis://user:@x.y.com:9475/3") {:server ["x.y.com" 9475], :init {:auth {:username "user" }, :select-db 3}})) + (is (= (#'opts/parse-string-server "rediss://user:@x.y.com:9475/3") {:server ["x.y.com" 9475], :init {:auth {:username "user" }, :select-db 3}, + :socket-opts {:ssl true}}))]) +(deftest _parse-conn-opts + [(is (enc/submap? (opts/parse-conn-opts false {:server [ "127.0.0.1" "80"]}) {:server ["127.0.0.1" 80]})) + (is (enc/submap? (opts/parse-conn-opts false {:server {:host "127.0.0.1" :port "80"}}) {:server ["127.0.0.1" 80]})) + (is (enc/submap? (opts/parse-conn-opts false {:server {:host "127.0.0.1" :port "80"}}) {:server ["127.0.0.1" 80]})) + (is (enc/submap? (opts/parse-conn-opts false {:server "rediss://user:pass@x.y.com:9475/3"}) + {:server ["x.y.com" 9475], :init {:auth {:username "user", :password "pass"}, :select-db 3, :resp3? true}, + :socket-opts {:ssl true}})) + + (is (->> (opts/parse-conn-opts false {:server ^:my-meta ["127.0.0.1" "6379"]}) :server (meta) :my-meta) "Retains metadata") + + (is (->> (opts/parse-conn-opts false {:server ["127.0.0.1" "invalid-port"]}) (throws? :any {:eid :carmine.conn-opts/invalid-server}))) + (is (->> (opts/parse-conn-opts false {:server {:host "127.0.0.1" :port "80" :invalid "foo"}}) (throws? :any {:eid :carmine.conn-opts/invalid-server}))) + + (is (enc/submap? + (opts/parse-conn-opts false + {:server {:sentinel-spec (sentinel/sentinel-spec {:foo/bar [["127.0.0.1" 26379]]}) + :master-name :foo/bar}}) + {:server {:master-name "foo/bar", :sentinel-opts {:retry-delay-ms 250}}})) + + (is (enc/submap? + (opts/parse-conn-opts false + {:server {:sentinel-spec (sentinel/sentinel-spec {:foo/bar [["127.0.0.1" 26379]]}) + :master-name :foo/bar, :sentinel-opts {:retry-delay-ms 100}}}) + {:server {:master-name "foo/bar", :sentinel-opts {:retry-delay-ms 100}}}))]) + +;;;; Sentinel + +(deftest _addr-utils + [(let [sm (#'sentinel/add-addrs->back nil [["ip1" 1] ["ip2" "2"] ^{:server-name "server3"} ["ip3" 3]]) + sm (#'sentinel/add-addr->front sm ["ip2" 2]) + sm (#'sentinel/add-addrs->back sm [["ip3" 3] ["ip6" 6]])] + + [(is (= sm [["ip2" 2] ["ip1" 1] ["ip3" 3] ["ip6" 6]])) + (is (= (mapv opts/descr-sock-addr sm) + [["ip2" 2] ["ip1" 1] ["ip3" 3 {:server-name "server3"}] ["ip6" 6]]))]) + + (let [sm (#'sentinel/add-addrs->back nil [["ip4" 4] ["ip5" "5"]]) + sm (#'sentinel/remove-addr sm ["ip4" 4])] + [(is (= sm [["ip5" 5]]))])]) + +(deftest _unique-addrs + [(is (= (#'sentinel/unique-addrs + {:m1 {:master [1 1] :sentinels [[1 1] [1 2] [2 2]]} + :m2 {:master [1 1] :sentinels [[3 3]] :replicas #{[1 1] [3 3]}}}) + + {:masters #{[1 1]}, + :replicas #{[3 3] [1 1]}, + :sentinels #{[1 1] [1 2] [2 2] [3 3]}}))]) + +(deftest _parse-nodes-info->addrs + [(is (= (#'sentinel/parse-nodes-info->addrs + [{"host" "host1" "port" "port1" "x1" "y1"} + {"host" "host2" "port" "port2"} + ["host" "host3" "port" "port3" "x2" "y2"]]) + + [["host1" "port1"] ["host2" "port2"] ["host3" "port3"]]))]) + +;;;; Cluster + +(deftest _cluster + [(is (= @(cluster/cluster-key "foo") 12182)) + (is (= @(cluster/cluster-key "ignore{foo}") 12182)) + (is (= @(cluster/cluster-key (cluster/cluster-key "ignore{foo}")) 12182))]) + + +;;;; Conns + +(defn- test-manager [mgr_] + (let [v (volatile! []) + v+ #(vswap! v conj %)] + + (with-open [mgr ^java.io.Closeable (force mgr_)] + (v+ + (car/with-car mgr + (fn [conn] + [(v+ (#'conns/conn? conn)) + (v+ (#'conns/conn-ready? conn)) + (v+ (resp/ping)) + (v+ (car/with-replies (resp/rcall "echo" "x")))]))) + + [@v mgr]))) + +(deftest _basic-conns + [(is (= (conns/with-new-conn tc+ + (fn [conn in out] + [(#'conns/conn? conn) + (#'conns/conn-ready? conn) + (resp/basic-ping! in out) + (resp/with-replies in out false false + (fn [] (resp/rcall "echo" "x")))])) + [true true "PONG" "x"]) + "Unmanaged conn") + + (let [[v mgr] (test-manager (delay (conns/conn-manager-unpooled {})))] + [(is (= [true true nil "x" "PONG"])) + (is (enc/submap? @mgr {:ready? false, :stats {:counts {:active 0, :created 1, :failed 0}}}))]) + + (let [[v mgr] (test-manager (delay (conns/conn-manager-pooled {})))] + [(is (= [true true nil "x" "PONG"])) + (is (enc/submap? @mgr + {:ready? false, + :stats {:counts {:idle 0, :returned 1, :created 1, :waiting 0, :active 0, :cleared 0, + :destroyed {:total 1}, :borrowed 1, :failed 0}}}))])]) + +(deftest _conn-manager-interrupt + (let [mgr (conns/conn-manager-unpooled {}) + k1 (tk "tlist") + f + (future + (wcar mgr + (resp/rcalls + ["del" k1] + ["lpush" k1 "x"] + ["lpop" k1] + ["blpop" k1 5] ; Block for 5 secs + )))] + + (Thread/sleep 1000) ; Wait for wcar to start but not complete + [(is (true? (car/conn-manager-close! mgr 0 {}))) ; Interrupt pool conns + (is (instance? java.net.SocketException (enc/ex-cause (enc/throws @f))) + "Close with zero timeout interrupts blocking blpop")])) + +(deftest _wcar-basics + [(is (= (wcar mgr_ (resp/ping)) "PONG")) + (is (= (wcar mgr_ {:as-vec? true} (resp/ping)) ["PONG"])) + (is (= (wcar mgr_ (resp/local-echo "hello")) "hello") "Local echo") + + (let [k1 (tk "k1") + v1 (str (rand-int 1e6))] + (is + (= (wcar mgr_ + (resp/ping) + (resp/rset k1 v1) + (resp/echo (wcar mgr_ (resp/rget k1))) + (resp/rset k1 "0")) + + ["PONG" "OK" v1 "OK"]) + + "Flush triggered by `wcar` in `wcar`")) + + (let [k1 (tk "k1") + v1 (str (rand-int 1e6))] + (is + (= (wcar mgr_ + (resp/ping) + (resp/rset k1 v1) + (resp/echo (with-replies (resp/rget k1))) + (resp/echo (str (= (with-replies (resp/rget k1)) v1))) + (resp/rset k1 "0")) + + ["PONG" "OK" v1 "true" "OK"]) + + "Flush triggered by `with-replies` in `wcar`")) + + (is (= (wcar mgr_ (resp/ping) (wcar mgr_)) "PONG") "Parent replies not swallowed by `wcar`") + (is (= (wcar mgr_ (resp/ping) (with-replies)) "PONG") "Parent replies not swallowed by `with-replies`") + + (is (= (let [k1 (tk "k1")] + (wcar mgr_ + (resp/rset k1 "v1") + (resp/echo + (with-replies + (car/skip-replies (resp/rset k1 "v2")) + (resp/echo + (with-replies (resp/rget k1))))))) + ["OK" "v2"])) + + (is (= + (wcar mgr_ + (resp/ping) + (resp/echo (first (with-replies {:as-vec? true} (resp/ping)))) + (resp/local-echo (first (with-replies {:as-vec? true} (resp/ping))))) + + ["PONG" "PONG" "PONG"]) + + "Nested :as-vec")]) + +;;;; Benching + +(deftest _benching + (do + (println) + (println "Benching times (1e4 laps)...") + (with-open [mgr-unpooled (conns/conn-manager-unpooled {}) + mgr-default (conns/conn-manager-pooled {}) + mgr-untested (conns/conn-manager-pooled {:pool-opts {:test-on-create? false + :test-on-borrow? false + :test-on-return? false}})] + + (println " - wcar/unpooled:" (enc/round0 (* (enc/qb 1e3 (wcar mgr-unpooled)) 10))) + (println " - wcar/default: " (enc/round0 (enc/qb 1e4 (wcar mgr-default)))) + (println " - wcar/untested:" (enc/round0 (enc/qb 1e4 (wcar mgr-untested)))) + (println " - ping/default: " (enc/round0 (enc/qb 1e4 (wcar mgr-default (resp/ping))))) + (println " - ping/untested:" (enc/round0 (enc/qb 1e4 (wcar mgr-untested (resp/ping)))))))) diff --git a/test/taoensso/carmine_v4/tests/resp.clj b/test/taoensso/carmine_v4/tests/resp.clj new file mode 100644 index 0000000..1ac3b82 --- /dev/null +++ b/test/taoensso/carmine_v4/tests/resp.clj @@ -0,0 +1,454 @@ +(ns taoensso.carmine-v4.tests.resp + "Low-level RESP protocol tests. + These don't need a running Redis server." + (:require + [clojure.test :as test :refer [deftest testing is]] + [taoensso.encore :as enc :refer [throws?]] + [taoensso.nippy :as nippy] + + [taoensso.carmine-v4.resp.common :as com + :refer [xs->in+ throw!]] + + [taoensso.carmine-v4.resp.read :as read] + [taoensso.carmine-v4.resp.write :as write] + [taoensso.carmine-v4 :as core]) + + (:import + [taoensso.carmine_v4.resp.common #_ReadOpts AsThawed #_Parser] + [taoensso.carmine_v4.resp.write ToFrozen])) + +(comment + (remove-ns 'taoensso.carmine-v4.tests.resp) + (test/run-tests 'taoensso.carmine-v4.tests.resp)) + +;;;; Common + +(deftest _byte-strings [(is (= (enc/utf8-ba->str (enc/str->utf8-ba enc/a-utf8-str)) enc/a-utf8-str) "UTF_8 charset for byte strings")]) +(deftest _with-out->str [(is (= (com/with-out->str (.write out (enc/str->utf8-ba enc/a-utf8-str))) enc/a-utf8-str))]) +(deftest _with-out->in [(is (= (.readLine (com/with-out->in (.write out (enc/str->utf8-ba "hello\r\n")))) "hello"))]) +(deftest _skip1 [(is (= (.readLine (com/skip1 (com/with-out->in (.write out (enc/str->utf8-ba "+hello\r\n"))))) "hello"))]) + +(deftest _xs->ba + [(is (= (enc/utf8-ba->str (com/xs->ba "a" "b" 1 (byte-array [(int \A) (int \B)]) \C [\d \e])) "ab1ABCde")) + (is (= (enc/utf8-ba->str (com/xs->ba+ "a" "b" 1 (byte-array [(int \A) (int \B)]) \C [\d \e])) "a\r\nb\r\n1\r\nAB\r\nC\r\nde\r\n"))]) + +(defn- test-blob-?marker [s] + (let [^bytes ba (enc/str->utf8-ba s) + in (com/ba->in ba)] + [(com/read-blob-?marker in (alength ba)) + (.readLine in)])) + +(deftest _read-blob-?marker + [(is (= (test-blob-?marker "foo") [nil "foo"])) + (is (= (test-blob-?marker "\u0000more") [nil "\u0000more"])) + (is (= (test-blob-?marker "\u0000_more") [:nil "more"])) + (is (= (test-blob-?marker "\u0000>more") [:npy "more"])) + (is (= (test-blob-?marker "\u0000> (com/discard-stream-separator (com/xs->in+ "")) (throws? :common {:eid :carmine.read/missing-stream-separator}))) + (is (->> (com/discard-crlf (com/xs->in+ "_")) (throws? :common {:eid :carmine.read/missing-crlf}))) + (is (true? (com/discard-crlf (com/xs->in+ ""))))]) + +(defn- test-rf-parser [kvs? ?xform rf init coll] + (let [rf* ((.-rfc (com/rf-parser {} ?xform rf)))] + (identity ; As (rf* completing [acc] acc) + (if kvs? + (reduce-kv rf* init coll) + (reduce rf* init coll))))) + +(deftest _rf-parser + [(testing "Basics" + [(is (= (test-rf-parser false nil (fn [acc in] (conj acc in)) [] [:a :b]) [:a :b])) + (is (->> (test-rf-parser false nil (fn [acc in] (throw! in)) [] [:a :b]) + (com/reply-error? {:thrown-by :rf})) "Identifies rf error") + + (is (= (test-rf-parser false (map identity) (fn [acc in] (conj acc in)) [] [:a :b]) [:a :b])) + (is (->> (test-rf-parser false (map throw!) (fn [acc in] (conj acc in)) [] [:a :b]) + (com/reply-error? {:thrown-by :xform})) "Identifies xform error") + + (is (= (test-rf-parser true nil (fn [acc k v] (assoc acc k v)) {} {:a :A}) {:a :A})) + (is (->> (test-rf-parser true nil (fn [acc k v] (throw! [k v])) {} {:a :A}) + (com/reply-error? {:thrown-by :rf})) + "kv-rf supported when no user-supplied xform")]) + + (testing "Stateful short-circuiting" + (let [xform (map (fn [ in] (if (and (int? in) (neg? ^long in)) (throw! in) in))) + rf (completing (fn [acc in] (if (and (int? in) (odd? ^long in)) (throw! in) in)))] + + [(testing "Permanently short-circuit on rf error" + (let [rf* ((.-rfc (com/rf-parser {} xform rf)))] + [(is (= (rf* :acc ) :acc)) + (is (= (rf* :acc 2) 2)) + (is (->> (rf* :acc 3) (com/reply-error? {:thrown-by :rf :args {:in {:value 3}}}))) + (is (->> (rf* :acc 2) (com/reply-error? {:thrown-by :rf :args {:in {:value 3}}}))) + (is (->> (rf* :acc -2) (com/reply-error? {:thrown-by :rf :args {:in {:value 3}}})))])) + + (testing "Permanently short-circuit on xform error" + (let [rf* ((.-rfc (com/rf-parser {} xform rf)))] + [(is (= (rf* :acc ) :acc)) + (is (= (rf* :acc 2) 2)) + (is (->> (rf* :acc -2) (com/reply-error? {:thrown-by :xform :args {:in {:value -2}}}))) + (is (->> (rf* :acc 2) (com/reply-error? {:thrown-by :xform :args {:in {:value -2}}}))) + (is (->> (rf* :acc 3) (com/reply-error? {:thrown-by :xform :args {:in {:value -2}}})))]))]))]) + +;;;; Read + +(enc/defalias rr read/read-reply) + +(deftest _read-reply + [(testing "Basics" + [(is (= (rr (xs->in+ "*10" "+simple string" ":1" ",1" ",1.5" ",inf" ",-inf" "(1" "#t" "#f" "_")) + ["simple string" 1 1.0 1.5 ##Inf ##-Inf 1N true false nil])) + + (is (= (rr (xs->in+ "$7" "hello\r\n")) "hello\r\n") "Binary safe") + (is (= (rr (xs->in+ "$?" ";5" "hello" ";9" " world!\r\n" ";0")) "hello world!\r\n") "Streaming")]) + + (testing "Basic aggregates" + [(is (= (rr (xs->in+ "*3" ":1" ":2" "+3")) [1 2 "3"])) + (is (= (binding [core/*keywordize-maps?* true] (rr (xs->in+ "%2" "+k1" "+v1" ":2" "+v2"))) {:k1 "v1", 2 "v2"})) + (is (= (binding [core/*keywordize-maps?* false] (rr (xs->in+ "%2" "+k1" "+v1" ":2" "+v2"))) {"k1" "v1", 2 "v2"})) + (is (= (rr (xs->in+ "*3" ":1" "$?" ";4" "bulk" ";6" "string" ";0" ",1.5")) [1 "bulkstring" 1.5])) + + (is (= (rr (xs->in+ "*2" ":1" "$3" [\a \b \c])) [1 "abc"]) "Baseline...") + (is (let [[x y] (com/as-bytes (rr (xs->in+ "*2" ":1" "$3" [\a \b \c])))] + [(is (= x 1)) + (is (= (enc/utf8-ba->str y) "abc"))]) + "`as-bytes` penetrates aggregates")]) + + (testing "Errors" + [(testing "Simple errors" + [(let [r1 (rr (xs->in+ "-ERR Foo bar baz"))] + (is (com/reply-error? + {:eid :carmine.read/error-reply + :message "ERR Foo bar baz" + :code "ERR"} + r1))) + + (let [[r1 r2 r3 r4] (rr (xs->in+ "*4" ":1" "-CODE1 a" ":2" "-CODE2 b"))] + [(is (= r1 1)) + (is (= r3 2)) + (com/reply-error? {:eid :carmine.read/error-reply :code "CODE1" :message "CODE1 a"} r2) + (com/reply-error? {:eid :carmine.read/error-reply :code "CODE2" :message "CODE2 b"} r4)])]) + + (testing "Bulk errors" + [(let [r1 (rr (xs->in+ "!10" "CODE Foo\r\n"))] + (is (com/reply-error? + {:eid :carmine.read/error-reply + :message "CODE Foo\r\n" + :code "CODE"} + r1) + "Binary safe")) + + (let [[r1 r2 r3 r4] (rr (xs->in+ "*4" ":1" "!9" "CODE1 a\r\n" ":2" "!9" "CODE2 b\r\n"))] + [(is (= r1 1)) + (is (= r3 2)) + (com/reply-error? {:eid :carmine.read/error-reply :code "CODE1" :message "CODE1 a\r\n"} r2) + (com/reply-error? {:eid :carmine.read/error-reply :code "CODE2" :message "CODE2 b\r\n"} r4)])])]) + + (testing "Nested aggregates" + [(is (= [[1 "2" 3] ["a" "b"] []] + (rr (xs->in+ + "*3" + "*3" ":1" "+2" ":3" + "*2" "+a" "+b" + "*0")))) + + (is (= [#{1 3 "2"} {:k1 "v1", 2 "v2"} [["a" "b"] [] #{} {}]] + (rr + (xs->in+ + "*3" + "~3" ":1" "+2" ":3" + "%2" "+k1" "+v1" ":2" "+v2" + "*4" + "*2" "+a" "+b" + "*0" + "~0" + "%0")))) + + (is (= {[1 "2" 3] #{1 3 "2"}, + {:k1 "v1"} {:k1 "v1", 2 2}, + #{"a" "b"} #{1 2}} + + (rr + (xs->in+ + "%3" + "*3" ":1" "+2" ":3" ; Array key + "~?" ":1" "+2" ":3" "." ; Set val + "%1" "+k1" "+v1" ; Map key + "%?" "+k1" "+v1" ":2" ":2" "." ; Map val + "~2" "+a" "+b" ; Set key + "~?" ":1" ":2" "." ; Set val + ))))]) + + (testing "Misc types" + [(is (= (rr (xs->in+ "=11" "txt:hello\r\n")) [:carmine/verbatim-string "txt" "hello\r\n"]) + "Verbatim string") + + (is (enc/submap? + {:carmine/attributes {:key-popularity {:a 0.1923 :b 0.0012}}} + (meta + (rr (xs->in+ "|1" "+key-popularity" + "%2" "$1" "a" ",0.1923" "$1" "b" ",0.0012" + "*2" ":2039123" ":9543892")))) + "Attributes")]) + + (testing "Pushes" + ;; Push replies can be received at any time, but only at the top level + ;; (e.g. not within the middle of a map reply) + [(let [p_ (promise) + pf (fn [dv] (deliver p_ dv)) + + reply + (binding [core/*push-fn* pf] + (rr + (xs->in+ + ">4" "+pubsub" "+message" "+channel" "+message content" + "$9" "get reply")))] + + [(is (= reply "get reply")) + (is (= (deref p_ 0 nil) ["pubsub" "message" "channel" "message content"]))])])]) + +(defn parser-error? + ([ x] (parser-error? nil x)) + ([subdata x] + (com/reply-error? + (assoc subdata :eid :carmine.read/parser-error) + x))) + +(deftest _read-reply-with-parsing + [(testing "fn parsers" + [(testing "Against non-aggregates" + [(is (= (rr (xs->in+ "+1")) "1")) + (is (= (com/as-long (rr (xs->in+ "+1"))) 1)) + (is (= (com/as-double (rr (xs->in+ "+1"))) 1.0)) + (is (->> (com/as-long (rr (xs->in+ "+s"))) parser-error?)) + (is (= (com/as-?long (rr (xs->in+ "+s"))) nil)) + (is (= (rr (xs->in+ "+kw")) "kw")) + (is (= (com/as-kw (rr (xs->in+ "+kw"))) :kw)) + + (is (= (com/parse {} (fn [x] (str x "!")) (rr (xs->in+ "+1"))) "1!")) + (is (->> (com/parse {} throw! (rr (xs->in+ "+1"))) parser-error?)) + + (testing "With parser opts" + [(testing ":parse-null-replies?" + [(is (= (com/parse {} (fn [_] :parsed) (rr (xs->in+ "_"))) nil)) + (is (= (com/parse {:parse-null-replies? true} (fn [_] :parsed) (rr (xs->in+ "_"))) :parsed))]) + + (testing ":parse-error-replies?" + [(is (-> (com/parse {} (fn [_] :parsed) (rr (xs->in+ "-err"))) com/reply-error?)) + (is (= (com/parse {:parse-error-replies? true} (fn [_] :parsed) (rr (xs->in+ "-err"))) :parsed))]) + + (testing ":read-mode" + [(is (= (com/parse {:read-mode :bytes} enc/utf8-ba->str (rr (xs->in+ "$5" "hello"))) "hello") "Parser read mode (:bytes)") + (is (= (com/parse {} enc/utf8-ba->str (com/as-bytes (rr (xs->in+ "$5" "hello")))) "hello") "Dynamic read mode (:bytes)") + (is (= (com/parse {:read-mode nil} #(str % "!") (com/as-bytes (rr (xs->in+ "$5" "hello")))) "hello!") "Parser read mode (nil)")])])]) + + (testing "Against aggregates" + [(is (= (rr (xs->in+ "*2" ":1" ":2")) [1 2]) "Baseline...") + (is (= (com/parse {} set (rr (xs->in+ "*2" ":1" ":2"))) #{1 2}) "Acts as (f )") + (is (= (rr (xs->in+ "*2" "*2" ":1" ":2" ":3")) [[1 2] 3]) "Baseline...") + (is (= (com/parse {} set (rr (xs->in+ "*2" "*2" ":1" ":2" ":3"))) #{[1 2] 3}) "No nesting") + (is (->> (com/parse {} throw! (rr (xs->in+ "*2" "*2" ":1" ":2" ":3"))) parser-error?))])]) + + (testing "rf parsers" + [(testing "Against aggregates" + [(is (= (rr (xs->in+ "*4" ":1" ":2" ":3" ":4")) [1 2 3 4]) "Baseline...") + (is (= (com/parse-aggregates {} nil (com/crf conj #{}) (rr (xs->in+ "*4" ":1" ":2" ":3" ":4"))) #{1 2 3 4}) "Parsed (without xform)") + (is (= (com/parse-aggregates {} (filter even?) (com/crf conj #{}) (rr (xs->in+ "*4" ":1" ":2" ":3" ":4"))) #{ 2 4}) "Parsed (with xform)") + (is (->> (com/parse-aggregates {} (map throw!) (com/crf conj #{}) (rr (xs->in+ "*4" ":1" ":2" ":3" ":4"))) parser-error?) "Trap xform errors") + (is (->> (com/parse-aggregates {} (map identity) (com/crf throw! #{}) (rr (xs->in+ "*4" ":1" ":2" ":3" ":4"))) parser-error?) "Trap rf errors") + (is (= (com/parse-aggregates {} (map identity) (com/crf conj #{}) (rr (xs->in+ "*4" ":1" "_" ":2" "_"))) #{nil 1 2}) "Nulls in aggregate") + + + (is (= (rr (xs->in+ "*4" ":1" ":2" ":3" ":4")) [1 2 3 4]) "Baseline...") + (is (= (com/parse-aggregates {} nil (com/crf conj! (transient #{}) persistent!) (rr (xs->in+ "*4" ":1" ":2" ":3" ":4"))) #{1 2 3 4}) "Using transients") + + (is (= (rr (xs->in+ "%2" "+k1" ":1" "+k2" ":2")) {:k1 1, :k2 2}) "Baseline...") + (is (= (com/parse-aggregates {} nil (com/crf (fn [m [k v]] (assoc m k v)) {}) (rr (xs->in+ "%2" "+k1" ":1" "+k2" ":2")) {"k1" 1, "k2" 2})) "Ignore *keywordize-maps?*") + (is (= (com/parse-aggregates {:kv-rf? true} nil (com/crf (fn [m k v] (assoc m k v)) {}) (rr (xs->in+ "%2" "+k1" ":1" "+k2" ":2")) {"k1" 1, "k2" 2})) "With kv-rf") + + (is (= (com/parse-aggregates {} + (filter (fn [[k v]] (even? v))) + (com/crf (fn [m [k v]] (assoc m k v)) {}) + (rr (xs->in+ "%2" "+k1" ":1" "+k2" ":2"))) {"k2" 2}) "Aggregate map, with xform") + + (is (= (rr (xs->in+ "*2" "*2" ":1" ":2" ":3")) [[1 2] 3]) "Baseline...") + (is (= (com/parse-aggregates {} nil (com/crf conj #{}) (rr (xs->in+ "*2" "*2" ":1" ":2" ":3"))) #{[1 2] 3}) "No nesting (without xform)") + (is (= (com/parse-aggregates {} (map identity) (com/crf conj #{}) (rr (xs->in+ "*2" "*2" ":1" ":2" ":3"))) #{[1 2] 3}) "No nesting (with xform)")]) + + (testing "Against non-aggregates" + [(is (= (com/parse-aggregates {} (map throw!) throw! (rr (xs->in+ "_"))) nil) "No effect") + (is (= (com/parse-aggregates {} (map throw!) throw! (rr (xs->in+ "+hello"))) "hello") "No effect")])])]) + +(defn- empty-bytes? [ba] (enc/ba= ba (byte-array 0))) + +(deftest _read-blob + [(testing "Basics" + [(is (= "" (#'read/read-blob nil nil (xs->in+ 0))) "As default: empty blob") + (is (empty-bytes? (#'read/read-blob :bytes nil (xs->in+ 0))) "As bytes: empty blob") + (is (= com/sentinel-null-reply (#'read/read-blob nil nil (xs->in+ -1))) "As default: RESP2 null") + (is (= com/sentinel-null-reply (#'read/read-blob :bytes nil (xs->in+ -1))) "As bytes: RESP2 null") + (is (= com/sentinel-null-reply (#'read/read-blob (AsThawed. {}) nil (xs->in+ -1))) "As thawed: RESP2 null") + + (is (= (#'read/read-blob nil nil (xs->in+ 5 "hello")) "hello")) + (is (= (enc/utf8-ba->str (#'read/read-blob :bytes nil (xs->in+ 5 "hello"))) "hello")) + + (is (= (#'read/read-blob nil nil (xs->in+ 7 "hello\r\n")) "hello\r\n") "Binary safe") + (is (= (enc/utf8-ba->str (#'read/read-blob :bytes nil (xs->in+ 7 "hello\r\n"))) "hello\r\n") "Binary safe") + + (let [pattern {:eid :carmine.read/missing-crlf}] + [(is (throws? :common pattern (#'read/read-blob nil nil (com/str->in "5\r\nhello")))) + (is (throws? :common pattern (#'read/read-blob :bytes nil (com/str->in "5\r\nhello")))) + (is (throws? :common pattern (#'read/read-blob nil nil (com/str->in "5\r\nhello__")))) + (is (throws? :common pattern (#'read/read-blob :bytes nil (com/str->in "5\r\nhello__"))))])]) + + (testing "Streaming" + [(is (= (#'read/read-blob nil nil (xs->in+ "?" ";5" "hello" ";1" " " ";6" "world!" ";0")) "hello world!")) + (is (= (enc/utf8-ba->str (#'read/read-blob :bytes nil (xs->in+ "?" ";5" "hello" ";1" " " ";6" "world!" ";0"))) "hello world!")) + + (let [pattern {:eid :carmine.read/missing-stream-separator}] + [(is (throws? :common pattern (#'read/read-blob nil nil (xs->in+ "?" ";5" "hello" "1" " " ";6" "world!" ";0")))) + (is (throws? :common pattern (#'read/read-blob :bytes nil (xs->in+ "?" ";5" "hello" "1" " " ";6" "world!" ";0"))))])]) + + (testing "Marked blobs" + ;; See also `common/_read-blob-?marker` tests + [(is (= (#'read/read-blob nil true (xs->in+ 5 "\u0000more")) "\u0000more")) + (is (= (#'read/read-blob nil true (xs->in+ 2 "\u0000_")) nil)) + (is (= (#'read/read-blob nil false (xs->in+ 2 "\u0000_")) "\u0000_")) + (is (= (enc/utf8-ba->str (#'read/read-blob nil true (xs->in+ 6 "\u0000in+ 6 "\u0000str (#'read/read-blob nil true (xs->in+ "5" (com/xs->ba com/ba-bin [\a \b \c])))) "abc")) + (is (= (enc/utf8-ba->str (#'read/read-blob :bytes true (xs->in+ "5" (com/xs->ba com/ba-bin [\a \b \c])))) "abc"))]) + + (let [data (nippy/stress-data {:comparable? true}) + ba (nippy/freeze data) + marked-ba (com/xs->ba com/ba-npy ba) + marked-len (alength ^bytes marked-ba)] + + (is (= (#'read/read-blob nil true (xs->in+ marked-len marked-ba)) data) "Simple Nippy data")) + + (let [data (nippy/stress-data {:comparable? true}) + pwd [:salted "secret"] + ba (nippy/freeze data {:password pwd}) + marked-ba (com/xs->ba com/ba-npy ba) + marked-len (alength ^bytes marked-ba)] + + [(is (= (#'read/read-blob (AsThawed. {:password pwd}) true (xs->in+ marked-len marked-ba)) data) + "Encrypted Nippy data (good password)") + + (let [r (#'read/read-blob nil true (xs->in+ marked-len marked-ba))] + [(is (com/reply-error? {:eid :carmine.read.blob/nippy-thaw-error} r) "Encrypted Nippy data (bad password)") + (is (enc/ba= (-> r ex-data :bytes :content) ba) "Unthawed Nippy data still provided")])])])]) + +(deftest _read-aggregate-by-ones-bootstrap + ;; Very basic bootstrap tests using only `read-basic-reply` + [(is (= (#'read/read-aggregate-by-ones [] com/read-opts-default nil (xs->in+ 0)) []) "Empty blob") + (is (= (#'read/read-aggregate-by-ones [] com/read-opts-default nil (xs->in+ -1)) com/sentinel-null-reply) "RESP2 null") + + (is (= (#'read/read-aggregate-by-ones [] com/read-opts-default #'read/read-basic-reply (xs->in+ 2 ":1" ":2")) [1 2])) + (is (= (#'read/read-aggregate-by-ones [] com/read-opts-default #'read/read-basic-reply (xs->in+ "?" ":1" ":2" ".")) [1 2]) "Streaming")]) + +(deftest _read-aggregate-by-pairs-bootstrap + ;; Very basic bootstrap tests using only `read-basic-reply` + [(testing "Basics" + [(is (= (#'read/read-aggregate-by-pairs com/read-opts-default nil (xs->in+ 0)) {}) "Empty blob") + (is (= (#'read/read-aggregate-by-pairs com/read-opts-default nil (xs->in+ -1)) com/sentinel-null-reply) "RESP2 null") + + (is (= (#'read/read-aggregate-by-pairs com/read-opts-default #'read/read-basic-reply (xs->in+ 2 "+k1" "+v1" "+k2" "+v2")) {:k1 "v1" :k2 "v2"}) "With keywordize") + (is (= (#'read/read-aggregate-by-pairs com/read-opts-natural #'read/read-basic-reply (xs->in+ 2 "+k1" "+v1" ":2" "+v2")) {"k1" "v1", 2 "v2"}) "W/o keywordize") + + (is (= (#'read/read-aggregate-by-pairs com/read-opts-default #'read/read-basic-reply (xs->in+ "?" "+k1" "+v1" ":2" "+v2" ".")) {:k1 "v1" 2 "v2"}) "Streaming, with keywordize") + (is (= (#'read/read-aggregate-by-pairs com/read-opts-natural #'read/read-basic-reply (xs->in+ "?" "+k1" "+v1" ":2" "+v2" ".")) {"k1" "v1", 2 "v2"}) "Streaming, w/o keywordize")])]) + +;;;; Write + +(def ^:const an-uncached-num (inc write/max-num-to-cache)) + +(deftest _write-nums + [(is (= (com/with-out->str (write/write-array-len out 12)) "*12\r\n")) + (is (= (com/with-out->str (write/write-array-len out an-uncached-num)) "*32768\r\n")) + + (is (= (com/with-out->str (#'write/write-bulk-len out 12)) "$12\r\n")) + (is (= (com/with-out->str (#'write/write-bulk-len out an-uncached-num)) "$32768\r\n")) + + (is (= (com/with-out->str (#'write/write-simple-long out 12)) ":12\r\n")) + (is (= (com/with-out->str (#'write/write-simple-long out an-uncached-num)) ":32768\r\n")) + + (is (= (com/with-out->str (#'write/write-bulk-long out 12)) "$2\r\n12\r\n")) + (is (= (com/with-out->str (#'write/write-bulk-long out an-uncached-num)) "$5\r\n32768\r\n")) + + (is (= (com/with-out->str (#'write/write-bulk-double out 12)) "$4\r\n12.0\r\n")) + (is (= (com/with-out->str (#'write/write-bulk-double out an-uncached-num)) "$7\r\n32768.0\r\n"))]) + +(deftest _write-bulk-str + [(is (= (com/with-out->str (#'write/write-bulk-str out "hello\r\n")) "$7\r\nhello\r\n\r\n")) + (is (= (com/with-out->str (#'write/write-bulk-str out enc/a-utf8-str)) "$47\r\nHi ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸ 10\r\n")) + + (testing "reserve-null!" + [(is (nil? (#'write/reserve-null! ""))) + (is (throws? :common {:eid :carmine.write/null-reserved} (#'write/reserve-null! "\u0000<")))]) + + (testing "Bulk num/str equivalence" + [(is (= + (com/with-out->str (#'write/write-bulk-double out 12.5)) + (com/with-out->str (#'write/write-bulk-str out "12.5")))) + (is (= + (com/with-out->str (#'write/write-bulk-double out (double an-uncached-num))) + (com/with-out->str (#'write/write-bulk-str out (str (double an-uncached-num))))))])]) + +(deftest _wrappers + [(is (= (enc/utf8-ba->str (.-ba (write/to-bytes (write/to-bytes (com/xs->ba [\a \b \c]))))) "abc")) + (is (= (.-freeze-opts (write/to-frozen {:a :A} (write/to-frozen {:b :B} "x"))) {:a :A})) + + (is (= (binding [core/*freeze-opts* {:o :O}] + (let [[c1 c2 c3] (write/to-frozen :dynamic "x" "y" "z")] + (mapv #(.-freeze-opts ^ToFrozen %) [c1 c2 c3]))) + [{:o :O} {:o :O} {:o :O}]) + "Multiple frozen arguments sharing dynamic config")]) + +(deftest _write-requests + [(testing "Basics" + [(is (= (enc/utf8-ba->str @#'write/bulk-nil) "$2\r\n\u0000_\r\n")) + (is (= (com/with-out->str (#'write/write-requests out [["hello\r\n"]])) "*1\r\n$7\r\nhello\r\n\r\n")) + (is (= (com/with-out->str (#'write/write-requests out [[enc/a-utf8-str]])) "*1\r\n$47\r\nHi ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸ 10\r\n")) + (is (= + (com/with-out->str + (#'write/write-requests out [["a1" "a2" "a3"] ["b1"] ["c1" "c2"]])) + "*3\r\n$2\r\na1\r\n$2\r\na2\r\n$2\r\na3\r\n*1\r\n$2\r\nb1\r\n*2\r\n$2\r\nc1\r\n$2\r\nc2\r\n") + + "Multiple reqs, with multiple args each") + + (is (= (com/with-out->str (#'write/write-requests out [["str" 1 2 3 4.0 :kw \x]])) + #_"*7\r\n$3\r\nstr\r\n:1\r\n:2\r\n:3\r\n$3\r\n4.0\r\n$2\r\nkw\r\n$1\r\nx\r\n" ; Simple nums + "*7\r\n$3\r\nstr\r\n$1\r\n1\r\n$1\r\n2\r\n$1\r\n3\r\n$3\r\n4.0\r\n$2\r\nkw\r\n$1\r\nx\r\n")) + + (is (= + (com/with-out->str (#'write/write-requests out [["-1" "0" "1" (str (dec write/min-num-to-cache)) (str (inc write/max-num-to-cache))]])) + (com/with-out->str (#'write/write-requests out [[ -1 0 1 (dec write/min-num-to-cache) (inc write/max-num-to-cache)]]))) + "Simple longs produce same output as longs or strings")]) + + (testing "Blob markers" + [(testing "Auto freeze enabled" + (binding [core/*auto-freeze?* true] + [(is (= (com/with-out->str (#'write/write-requests out [[nil]])) "*1\r\n$2\r\n\u0000_\r\n") "nil arg => ba-nil marker") + (is (= (com/with-out->str (#'write/write-requests out [[{}]])) "*1\r\n$7\r\n\u0000>NPY\u0000\r\n") "clj arg => ba-npy marker") + + (let [ba (byte-array [(int \a) (int \b) (int \c)])] + [(is (= (com/with-out->str (#'write/write-requests out [[ ba]])) "*1\r\n$5\r\n\u0000str (#'write/write-requests out [[(write/to-bytes ba)]])) "*1\r\n$3\r\nabc\r\n") "Unmarked bin")])])) + + (testing "Auto freeze disabled" + (binding [core/*auto-freeze?* false] + (let [pattern {:eid :carmine.write/non-native-arg-type}] + [(is (throws? :common pattern (com/with-out->str (#'write/write-requests out [[nil]]))) "nil arg => throw") + (is (throws? :common pattern (com/with-out->str (#'write/write-requests out [[{}]]))) "clj arg => throw") + + (let [ba (byte-array [(int \a) (int \b) (int \c)])] + [(is (= (com/with-out->str (#'write/write-requests out [[ ba]])) "*1\r\n$3\r\nabc\r\n") "Unmarked bin") + (is (= (com/with-out->str (#'write/write-requests out [[(write/to-bytes ba)]])) "*1\r\n$3\r\nabc\r\n") "Same unmarked bin with `to-bytes`")])])))])])