[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.

Author: iarenaza

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
 

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))))
 

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."

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
 

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)

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