branch: elpa/cider
commit 8569592c36a68b13fa76fb1294bb0559a218653b
Author: Iñaki Arenaza <inaki.aren...@biotz.io>
Commit: Bozhidar Batsov <bozhi...@batsov.dev>
[Fix: #3786] Sort dictionaries by key in nrepl-bencode
CIDER doesn't adhere to Bencode spec which requires dictionary keys to
be sorted alphabetically. This hasn't been a problem so far because
the bencode reader on nREPL side doesn't validate the order of
keys. Still, it will be rigorous to produce correct values according
to the selected format.
---
CHANGELOG.md | 1 +
nrepl-client.el | 19 +++++++++++-
nrepl-dict.el | 4 ++-
test/nrepl-bencode-tests.el | 44 ++++++++++++++++++++++++--
test/nrepl-server-mock.el | 69 +++++++++++++++++++++++++++++++----------
test/utils/nrepl-tests-utils.el | 44 ++++++++++++++++++++++++++
6 files changed, 159 insertions(+), 22 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8be4f326b9..0f972f2d7a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -34,6 +34,7 @@
### Bugs fixed
- [#3784](https://github.com/clojure-emacs/cider/issues/3784): Inspector: make
point less erratic when navigating between inspector screens.
+- [#3786](https://github.com/clojure-emacs/cider/issues/3786): Sort
dictionaries by key in nrepl-bencode
### Bugs fixed
diff --git a/nrepl-client.el b/nrepl-client.el
index 97d53503e8..b5b50ba48a 100644
--- a/nrepl-client.el
+++ b/nrepl-client.el
@@ -423,13 +423,30 @@ decoded message or nil if the strings were completely
decoded."
(erase-buffer)
(cons string-q response-q))))
+(defun nrepl--bencode-dict (dict)
+ "Encode DICT with bencode.
+According to the Bittorrent protocol specification[1], when bencoding
+dictionaries, keys must be strings and appear in sorted order (sorted as
+raw strings, not alphanumerics).
+
+[1] https://www.bittorrent.org/beps/bep_0003.html#bencoding";
+ (let* ((sorted-keys (sort (nrepl-dict-keys dict)
+ (lambda (a b)
+ (string< a b))))
+ (sorted-dict (nrepl-dict)))
+ (dolist (k sorted-keys sorted-dict)
+ (nrepl-dict-put sorted-dict
+ k
+ (nrepl-dict-get dict k)))
+ (mapconcat #'nrepl-bencode (cdr sorted-dict) "")))
+
(defun nrepl-bencode (object)
"Encode OBJECT with bencode.
Integers, lists and nrepl-dicts are treated according to bencode
specification. Everything else is encoded as string."
(cond
((integerp object) (format "i%de" object))
- ((nrepl-dict-p object) (format "d%se" (mapconcat #'nrepl-bencode (cdr
object) "")))
+ ((nrepl-dict-p object) (format "d%se" (nrepl--bencode-dict object)))
((listp object) (format "l%se" (mapconcat #'nrepl-bencode object "")))
(t (format "%s:%s" (string-bytes object) object))))
diff --git a/nrepl-dict.el b/nrepl-dict.el
index 09d5fabb1c..e946dacfbe 100644
--- a/nrepl-dict.el
+++ b/nrepl-dict.el
@@ -37,7 +37,9 @@
(defun nrepl-dict (&rest key-vals)
"Create nREPL dict from KEY-VALS."
- (cons 'dict key-vals))
+ (if (cl-evenp (length key-vals))
+ (cons 'dict key-vals)
+ (error "An even number of KEY-VALS is needed to build a dict object")))
(defun nrepl-dict-from-hash (hash)
"Create nREPL dict from HASH."
diff --git a/test/nrepl-bencode-tests.el b/test/nrepl-bencode-tests.el
index a4e3e59cbb..410c5f186c 100644
--- a/test/nrepl-bencode-tests.el
+++ b/test/nrepl-bencode-tests.el
@@ -327,10 +327,48 @@ If object is incomplete, return a decoded path."
"int" 1
"int-list" (1 2 3 4 5)
"string" "f30dbd69-7095-40c1-8e98-7873ae71a07f"
- "dict" (dict "k1" 1 "k2" 2 "k3" "333333")
+ "unordered-dict" (dict "k3" "333333" "k2" 2 "k1" 1)
"status" ("eval-error")))
- (expect (car (nrepl-bdecode-string (nrepl-bencode obj)))
- :to-equal obj))))
+ ;; Bencoded dicts may change the order of the keys of original
+ ;; dict, as bencoding a dict MUST encode the keys in sorted
+ ;; order. We need to compare objects taking this into account.
+ (expect (bencodable-obj-equal?
+ obj
+ (car (nrepl-bdecode-string (nrepl-bencode obj))))
+ :to-be t))))
+
+(describe "nrepl--bencode"
+ (it "encodes strings"
+ (expect (nrepl-bencode "spam") :to-equal "4:spam")
+ (expect (nrepl-bencode "") :to-equal "0:")
+ ;; Assuming we use UTF-8 encoded strings, which
+ ;; Clojure/Clojurescript do.
+ (expect (nrepl-bencode "Божидар") :to-equal "14:Божидар"))
+
+ (it "encodes integers"
+ (expect (nrepl-bencode 3) :to-equal "i3e")
+ (expect (nrepl-bencode -3) :to-equal "i-3e"))
+
+ (it "encodes lists"
+ (expect (nrepl-bencode '("spam" "eggs"))
+ :to-equal "l4:spam4:eggse")
+ (expect (nrepl-bencode '("spam" ("eggs" "salt")))
+ :to-equal "l4:spaml4:eggs4:saltee")
+ (expect (nrepl-bencode '(1 2 3 (4 5 (6)) 7 8))
+ :to-equal "li1ei2ei3eli4ei5eli6eeei7ei8ee"))
+
+ (it "encodes dicts"
+ (expect (nrepl-bencode '(dict "spam" "eggs" "cow" "moo"))
+ :to-equal "d3:cow3:moo4:spam4:eggse")
+ (expect (nrepl-bencode '(dict "spam" "eggs"
+ "cow" (dict "foo" "foobar" "bar" "baz")))
+ :to-equal "d3:cowd3:bar3:baz3:foo6:foobare4:spam4:eggse"))
+
+ (it "handles nils"
+ (expect (nrepl-bencode '("" nil (dict "" nil)))
+ :to-equal "l0:led0:leee")
+ (expect (nrepl-bencode '("" nil (dict "cow" nil "" 6)))
+ :to-equal "l0:led0:i6e3:cowleee")))
;; benchmarks
diff --git a/test/nrepl-server-mock.el b/test/nrepl-server-mock.el
index d02995bedc..4b3eb98d00 100644
--- a/test/nrepl-server-mock.el
+++ b/test/nrepl-server-mock.el
@@ -33,38 +33,73 @@
(require 'queue)
(require 'cl)
+(defun nrepl-server-mock--get-keys (dict keys)
+ "Get the values for KEYS from nrepl-dict DICT.
+Get them as a list, so they can be easily consumed by
+`cl-destructuring-bind`."
+ (mapcar (lambda (k) (nrepl-dict-get dict k)) keys))
+
(defun nrepl-server-mock-filter (proc output)
"Handle the nREPL message found in OUTPUT sent by the client PROC.
Minimal implementation, just enough for fulfilling clients' testing
-requirements."
+requirements.
+
+Additional complexity is added by the fact that bencoded dictionaries
+must have their keys in sorted order. But we don't want to have to
+remember to write them down as such in the test values here (because
+there is ample room for mistakes that are harder to debug)."
;; (mock/log! ":mock.filter/output %s :msg %s" proc output)
(condition-case error-details
(let* ((msg (queue-dequeue (cdr (nrepl-bdecode output))))
(_ (mock/log! ":mock.filter/msg :in %S" msg))
+ ;; Message id and session are needed for all request
+ ;; messages and responses. Get them once here.
+ (msg-id (nrepl-dict-get msg "id"))
+ (msg-session (nrepl-dict-get msg "session"))
(response (pcase msg
- (`(dict "op" "clone"
- "client-name" "CIDER"
- "client-version" ,cider-version
- "id" ,id)
- `(dict "id" ,id
+ ((pred (lambda (msg)
+ (let ((keys '("client-version")))
+ (cl-destructuring-bind (client-version)
(nrepl-server-mock--get-keys msg keys)
+ (bencodable-obj-equal? msg
+ `(dict "op"
"clone"
+
"client-name" "CIDER"
+
"client-version" ,client-version
+ "id"
,msg-id))))))
+ `(dict "id" ,msg-id
"session" "a-session"
"status" ("done")
"new-session" "a-new-session"))
- (`(dict "op" "describe" "session" ,session "id" ,id)
- `(dict "id" ,id "session" ,session "status"
- ("done")))
+ ((pred (bencodable-obj-equal? `(dict "op" "describe"
+ "id" ,msg-id
+ "session"
,msg-session)))
+ `(dict "id" ,msg-id
+ "session" ,msg-session
+ "status" ("done")))
+
;; Eval op can include other fields in addition to the
;; code, we only need the signature and the session
and
- ;; id fields at the end.
- (`(dict "op" "eval" "code" ,_code . ,rest)
- (cl-destructuring-bind (_ session _ id) (seq-drop
rest (- (seq-length rest) 4))
- `(dict "id" ,id "session" ,session "status"
- ("done"))))
- (`(dict "op" "close" "session" ,session "id" ,id)
- `(dict "id" ,id "session" ,session "status"
- ("done"))))))
+ ;; id fields.
+ ((pred (lambda (msg)
+ (let ((keys '("op")))
+ (cl-destructuring-bind (op)
(nrepl-server-mock--get-keys msg keys)
+ (bencodable-obj-equal? `(dict "op" ,op
+ "id"
,msg-id
+ "session"
,msg-session)
+ `(dict "op" "eval"
+ "id"
,msg-id
+ "session"
,msg-session))))))
+ `(dict "id" ,msg-id
+ "session" ,msg-session
+ "status" ("done")))
+
+ ((pred (bencodable-obj-equal? `(dict "op" "close"
+ "id" ,msg-id
+ "session"
,msg-session)))
+ `(dict "id" ,msg-id
+ "session" ,msg-session
+ "status" ("done"))))))
(mock/log! ":mock.filter/msg :out %S" response)
(if (not response)
diff --git a/test/utils/nrepl-tests-utils.el b/test/utils/nrepl-tests-utils.el
index 11ec71f3e8..64b7e4af3a 100644
--- a/test/utils/nrepl-tests-utils.el
+++ b/test/utils/nrepl-tests-utils.el
@@ -113,6 +113,50 @@ calling process."
(message
":nrepl-mock-server-process-started...")))))
server-process))
+(defun bencodable-obj-equal? (obj1 obj2)
+ "Compare bencodable objects OBJ1 and OBJ2 for equality.
+They are considered equal if they have the same content. Dicts are
+considered equal if they have the same key-value pairs, even if the keys
+appear in different order."
+ (cond
+ ((nrepl-dict-p obj1)
+ (if (not (nrepl-dict-p obj2))
+ nil
+ (let ((obj1-keys (sort (nrepl-dict-keys obj1)
+ (lambda (a b)
+ (string< a b))))
+ (obj2-keys (sort (nrepl-dict-keys obj2)
+ (lambda (a b)
+ (string< a b)))))
+ (if (not (equal obj1-keys obj2-keys))
+ nil
+ (seq-every-p #'identity
+ (mapcar (lambda (key)
+ (bencodable-obj-equal?
+ (nrepl-dict-get obj1 key)
+ (nrepl-dict-get obj2 key)))
+ obj1-keys))))))
+ ((listp obj1)
+ (if (not (and (listp obj2)
+ (= (length obj1)
+ (length obj2))))
+ nil
+ (seq-every-p #'identity
+ (cl-mapcar (lambda (obj1 obj2)
+ (bencodable-obj-equal? obj1 obj2))
+ obj1
+ obj2))))
+ ((integerp obj1)
+ (if (not (integerp obj2))
+ nil
+ (= obj1 obj2)))
+ ((stringp obj1)
+ (if (not (stringp obj2))
+ nil
+ (string= obj1 obj2)))
+ ;; Any other kind of value is not a bencodable value.
+ nil))
+
(provide 'nrepl-tests-utils)
;;; nrepl-tests-utils.el ends here
