[Fix: #3786] Sort dictionaries by key in nrepl-bencode

CHANGELOG.md

@@ -33,6 +33,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