From d7145a756be92480ce74178bf15f1352c2bb67dd Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Fri, 7 Apr 2023 09:34:57 +0000
Subject: [PATCH] Implement an option to sort map keys on serialization

---
 common.rkt               | 12 ++++++++++--
 encode.rkt               | 10 +++++++---
 info.rkt                 |  2 +-
 scribblings/manual.scrbl | 12 ++++++++++--
 4 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/common.rkt b/common.rkt
index 979fb0a..79f9370 100644
--- a/common.rkt
+++ b/common.rkt
@@ -31,9 +31,11 @@
 (provide cbor-config?
          cbor-config-tag-deserializers
          cbor-config-null-value
+         cbor-config-sorted-map-keys
          (contract-out
           [cbor-empty-config cbor-config?]
           [with-cbor-null (-> cbor-config? any/c cbor-config?)]
+          [with-sorted-map-keys (-> cbor-config? boolean? cbor-config?)]
           [with-cbor-tag-deserializer (-> cbor-config?
                                           cbor-valid-tag-number?
                                           (-> cbor-valid-tag-number? any/c any/c)
@@ -41,9 +43,10 @@
 
 (struct cbor-config
   (tag-deserializers
-   null-value))
+   null-value
+   sorted-map-keys))
 
-(define cbor-empty-config (cbor-config #hasheqv() 'null))
+(define cbor-empty-config (cbor-config #hasheqv() 'null #f))
 
 (define (with-cbor-tag-deserializer config id deser)
   (define old-handlers (cbor-config-tag-deserializers config))
@@ -55,3 +58,8 @@
   (struct-copy
    cbor-config config
    [null-value v]))
+
+(define (with-sorted-map-keys config sorted)
+  (struct-copy
+   cbor-config config
+   [sorted-map-keys sorted]))
diff --git a/encode.rkt b/encode.rkt
index 4439a73..c0a2a07 100644
--- a/encode.rkt
+++ b/encode.rkt
@@ -93,9 +93,13 @@
 (define (cbor-write-map config m out)
   (define len (hash-count m))
   (write-argument out 5 len)
-  (hash-for-each m (lambda (k v)
-                     (cbor-write config k out)
-                     (cbor-write config v out)))
+  (if (cbor-config-sorted-map-keys config)
+      (for-each (lambda (pair)
+                   (cbor-write config (car pair) out)
+                   (cbor-write config (cdr pair) out)) (sort (hash->list m) < #:key car))
+      (hash-for-each m (lambda (k v)
+                         (cbor-write config k out)
+                         (cbor-write config v out))))
   (when (> len u64-max)
     (write-break out)))
 
diff --git a/info.rkt b/info.rkt
index 3b94a5c..21104fa 100644
--- a/info.rkt
+++ b/info.rkt
@@ -1,6 +1,6 @@
 #lang info
 (define collection "cbor")
-(define version "0.9")
+(define version "0.10")
 (define deps '("base"))
 (define build-deps '("racket-doc"
                      "rackunit-lib"
diff --git a/scribblings/manual.scrbl b/scribblings/manual.scrbl
index 21e0047..66c9a06 100644
--- a/scribblings/manual.scrbl
+++ b/scribblings/manual.scrbl
@@ -55,12 +55,14 @@ Major types are decoded as follows:
 }
 
 @section{Configuration Options}
-@defstruct[cbor-config ((tag-deserializers (hash/c cbor-valid-tag-number? (-> cbor-valid-tag-number? any/c any/c))) (null-value any/c))]{
+@defstruct[cbor-config ((tag-deserializers (hash/c cbor-valid-tag-number? (-> cbor-valid-tag-number? any/c any/c))) (null-value any/c) (sorted-map-keys boolean?))]{
 Configuration object for CBOR encoding and decoding. Note that this struct is only exposed opaquely, and must be manipulated with the provided functions and values.
 
 @racket[tag-deserializers] is a hash from CBOR tag numbers to a procedure that takes the CBOR tag number and a raw data value and produces the meaningful interpretation of that value.
 
 @racket[null-value] is the value that CBOR @tt{null} will be encoded and decoded as.
+
+@racket[sorted-map-keys] determines whether or not map keys should be serialized in sorted order. This only affects encoding; unsorted map keys will still be decoded identically.
 }
 
 @defthing[cbor-empty-config cbor-config?]{
@@ -80,6 +82,12 @@ Registers a tag deserializer to the given config, returning a new config.
 Registers a null value to the given config, returning a new config.
 }
 
+@defproc[(with-sorted-map-keys [config cbor-config?]
+                               [v boolean?])
+         cbor-config?]{
+Set whether map keys should be serialized in sorted order.
+}
+
 @defthing[gen:cbor-custom-write any/c]{
 A @tech{generic interface} that supplies a method, @racket[cbor-write-proc] that can serialize arbitrary values to CBOR. Implementations of the method should accept a value to be serialized and return it in serialized form as a @racket[cbor-tag?].
 }
@@ -113,4 +121,4 @@ Patches to improve these issues are welcome! Email patches to @tt{~williewillus/
 @item{There should be a config or parameter to specify maximum lengths for indefinite-length objects}
 @item{More correctness-testing is needed.}
 @item{Some recommended tag and simple values from the RFC are not supported yet.}
-]
\ No newline at end of file
+]
-- 
2.45.2