5 files changed, 216 insertions(+), 98 deletions(-)

M common.rkt
M decode.rkt
M encode.rkt
A private/test_data.rkt
A private/util.rkt

@@ 2,33 2,32 @@
 
 (require racket/contract)
 
-(provide unassigned-simple-value?)
-(define unassigned-simple-value?
+(provide cbor-unassigned-simple-value?)
+(define cbor-unassigned-simple-value?
   (or/c (integer-in 0 19) (integer-in 32 255)))
 
 (provide (contract-out
-          [struct simple-value
-            ([inner unassigned-simple-value?])]))
+          [struct cbor-simple-value
+            ([inner cbor-unassigned-simple-value?])]))
 
-(struct simple-value
+(struct cbor-simple-value
   (inner)
   #:transparent)
 
-(provide valid-tag-number?)
-(define valid-tag-number?
+(provide cbor-valid-tag-number?)
+(define cbor-valid-tag-number?
   (integer-in 0 18446744073709551616))
 
 (provide (contract-out
-          [struct tagged-value
-            ([tag valid-tag-number?]
-             [value any/c])]))
+          [struct cbor-tag
+            ([number cbor-valid-tag-number?]
+             [content any/c])]))
 
-(struct tagged-value
-  (tag
-   value)
+(struct cbor-tag
+  (number
+   content)
   #:transparent)
 
-
 (provide cbor-config?
          cbor-config-tag-deserializers
          cbor-config-null-value

@@ 3,7 3,8 @@
 (require racket/undefined
          "common.rkt")
 
-(provide cbor-read)
+(provide cbor-read
+         default-config)
 
 (define (expect-byte port)
   (define res (read-byte port))


@@ 122,12 123,12 @@
   (let* ([tag (read-argument port 6 additional)]
          [data (cbor-read config port)]
          [handler (hash-ref (cbor-config-tag-deserializers config)
-                            tag (lambda () tagged-value))])
+                            tag (lambda () cbor-tag))])
     (handler tag data)))
 
 (define (parse-simple-value config n)
-  (if (unassigned-simple-value? n)
-      (simple-value n)
+  (if (cbor-unassigned-simple-value? n)
+      (cbor-simple-value n)
       (case n
         [(20) #f]
         [(21) #t]


@@ 225,40 226,25 @@
 
 (module* test #f
   (require rackunit
-           racket/list)
+           racket/list
+           "private/util.rkt"
+           "private/test_data.rkt")
 
-  (define (hex-bytes s)
-    (if (not (even? (string-length s)))
-        (raise-argument-error "Must be even length string")
-        (list->bytes
-         (map (lambda (i)
-                (string->number (substring s (* 2 i) (+ (* 2 i) 2))
-                                16))
-              (range (/ (string-length s) 2))))))
+  (define (try-bytes bytes)
+    (cbor-read default-config (open-input-bytes bytes)))
 
   (define (try str)
-    (cbor-read default-config (open-input-bytes (hex-bytes str))))
+    (try-bytes (hex-bytes str)))
 
   (test-case
       "Deserialization - RFC 8949 Int and Bignum Examples"
-    (check-eqv? (try "00") 0)
-    (check-eqv? (try "01") 1)
-    (check-eqv? (try "0a") 10)
-    (check-eqv? (try "17") 23)
-    (check-eqv? (try "1818") 24)
-    (check-eqv? (try "1819") 25)
-    (check-eqv? (try "1864") 100)
-    (check-eqv? (try "1903e8") 1000)
-    (check-eqv? (try "1a000f4240") 1000000)
-    (check-eqv? (try "1b000000e8d4a51000") 1000000000000)
-    (check-eqv? (try "1bffffffffffffffff") 18446744073709551615)
+    (for ([pair (in-list int-bignum-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected)))
+    ; bignums TODO move to common
     (check-eqv? (try "c249010000000000000000") 18446744073709551616)
-    (check-eqv? (try "3bffffffffffffffff") -18446744073709551616)
-    (check-eqv? (try "c349010000000000000000") -18446744073709551617)
-    (check-eqv? (try "20") -1)
-    (check-eqv? (try "29") -10)
-    (check-eqv? (try "3863") -100)
-    (check-eqv? (try "3903e7") -1000))
+    (check-eqv? (try "c349010000000000000000") -18446744073709551617))
 
   (test-case
       "Deserialization - RFC 8949 Float Examples"


@@ 287,25 273,20 @@
 
   (test-case
       "Deserialization - RFC 8949 Bytestring and String Examples"
-    (check-equal? (try "40") #"")
-    (check-equal? (try "4401020304") (hex-bytes "01020304"))
-    (check-equal? (try "60") "")
-    (check-equal? (try "6161") "a")
-    (check-equal? (try "6449455446") "IETF")
-    (check-equal? (try "62225c") "\"\\")
-    (check-equal? (try "62c3bc") "\u00fc")
-    (check-equal? (try "63e6b0b4") "\u6c34")
-    (check-equal? (try "64f0908591") "\ud800\udd51")
+    (for ([pair (in-list bytes-string-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected)))
     ; indefinite length
     (check-equal? (try "7f657374726561646d696e67ff") "streaming")
     (check-equal? (try "5f42010243030405ff") #"\1\2\3\4\5"))
 
   (test-case
       "Deserialization - RFC 8949 List Examples"
-    (check-equal? (try "80") '())
-    (check-equal? (try "83010203") '(1 2 3))
-    (check-equal? (try "8301820203820405") '(1 (2 3) (4 5)))
-    (check-equal? (try "98190102030405060708090a0b0c0d0e0f101112131415161718181819") (range 1 26))
+    (for ([pair (in-list list-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected)))
     ; indefinite length
     (check-equal? (try "9fff") '())
     (check-equal? (try "9f018202039f0405ffff") '(1 (2 3) (4 5)))


@@ 315,10 296,10 @@
 
   (test-case
       "Deserialization - RFC 8949 Map and Mixed Map/List Examples"
-    (check-equal? (try "a0") #hash())
-    (check-equal? (try "a201020304") #hash((1 . 2) (3 . 4)))
-    (check-equal? (try "a26161016162820203") #hash(("a" . 1) ("b" . (2 3))))
-    (check-equal? (try "826161a161626163") '("a" #hash(("b" . "c"))))
+    (for ([pair (in-list map-mixed-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected)))
     (check-equal? (try "a56161614161626142616361436164614461656145")
                   #hash(("a" . "A") ("b" . "B") ("c" . "C") ("d" . "D") ("e" . "E")))
     ;indefinite length


@@ 328,23 309,21 @@
 
   (test-case
       "Deserialization - RFC 8949 Simple Value Examples"
-    (check-equal? (try "f4") #f)
-    (check-equal? (try "f5") #t)
-    (check-equal? (try "f6") 'null)
-    (check-equal? (try "f7") undefined)
-    (check-equal? (try "f0") (simple-value 16))
-    (check-equal? (try "f8ff") (simple-value 255)))
+    (for ([pair (in-list simple-value-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected))))
 
   (test-case
       "Deserialization - RFC 8949 Tag Examples"
     (check-equal? (try "c074323031332d30332d32315432303a30343a30305a")
-                  (tagged-value 0 "2013-03-21T20:04:00Z"))
-    (check-equal? (try "c11a514b67b0") (tagged-value 1 1363896240))
-    (check-equal? (try "c1fb41d452d9ec200000") (tagged-value 1 1363896240.5))
-    (check-equal? (try "d74401020304") (tagged-value 23 #"\1\2\3\4"))
-    (check-equal? (try "d818456449455446") (tagged-value 24 #"\x64\x49\x45\x54\x46"))
+                  (cbor-tag 0 "2013-03-21T20:04:00Z"))
+    (check-equal? (try "c11a514b67b0") (cbor-tag 1 1363896240))
+    (check-equal? (try "c1fb41d452d9ec200000") (cbor-tag 1 1363896240.5))
+    (check-equal? (try "d74401020304") (cbor-tag 23 #"\1\2\3\4"))
+    (check-equal? (try "d818456449455446") (cbor-tag 24 #"\x64\x49\x45\x54\x46"))
     (check-equal? (try "d82076687474703a2f2f7777772e6578616d706c652e636f6d")
-                  (tagged-value 32 "http://www.example.com")))
+                  (cbor-tag 32 "http://www.example.com")))
 
   (test-case
       "Deserialization - Misc Tags"

@@ 59,45 59,45 @@
     (write-break out)))
 
 (define (cbor-write-string v out)
-  (define len (string-length v))
-  (write-argument out 3 len)
-  (write-bytes (string->bytes/utf-8 v) out)
-  (when (> len u64-max)
+  (define serialized (string->bytes/utf-8 v))
+  (write-argument out 3 (bytes-length serialized))
+  (write-bytes serialized out)
+  (when (> (bytes-length serialized) u64-max)
     (write-break out)))
 
-(define (cbor-write-list lst out)
+(define (cbor-write-list config lst out)
   (define len (length lst))
   (write-argument out 4 len)
-  (for-each (lambda (v) (cbor-write v out)) lst)
+  (for-each (lambda (v) (cbor-write config v out)) lst)
   (when (> len u64-max)
     (write-break out)))
 
-(define (cbor-write-vector vec out)
+(define (cbor-write-vector config vec out)
   (define len (vector-length vec))
   (write-argument out 4 len)
   (for ([v (in-vector vec)])
-    (cbor-write v out))
+    (cbor-write config v out))
   (when (> len u64-max)
     (write-break out)))
 
-(define (cbor-write-seq seq out)
+(define (cbor-write-seq config seq out)
   (write-byte (combine 4 31) out)
   (for ([v seq])
-    (cbor-write v out))
+    (cbor-write config v out))
   (write-break out))
 
-(define (cbor-write-map m out)
-  (define len (length m))
+(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 k out)
-                     (cbor-write v out)))
+                     (cbor-write config k out)
+                     (cbor-write config v out)))
   (when (> len u64-max)
     (write-break out)))
 
-(define (cbor-write-tag v out)
-  (write-argument out 6 (tagged-value-tag v))
-  (cbor-write (tagged-value-value v) out))
+(define (cbor-write-tag config v out)
+  (write-argument out 6 (cbor-tag-number v))
+  (cbor-write config (cbor-tag-content v) out))
 
 (define (cbor-write-float v out)
   (write-byte (combine 7 26) out)


@@ 108,7 108,7 @@
   (write-bytes (real->floating-point-bytes v 8 #t) out))
 
 (define (cbor-write-simple-value v out)
-  (define inner (simple-value-inner v))
+  (define inner (cbor-simple-value-inner v))
   (if (<= inner 23)
       (write-byte (combine 7 inner) out)
       (begin


@@ 129,10 129,63 @@
     [(flonum? v) (cbor-write-double v out)]
     [(bytes? v) (cbor-write-bytes v out)]
     [(string? v) (cbor-write-string v out)]
-    [(list? v) (cbor-write-list v out)]
-    [(vector? v) (cbor-write-vector v out)]
-    [(hash? v) (cbor-write-map v out)]
-    [(sequence? v) (cbor-write-seq v out)]
-    [(tagged-value?) (cbor-write-tag v out)] ; todo handle interpreted values
-    [(simple-value? v) (cbor-write-simple-value v out)]
+    [(list? v) (cbor-write-list config v out)]
+    [(vector? v) (cbor-write-vector config v out)]
+    [(hash? v) (cbor-write-map config v out)]
+    [(sequence? v) (cbor-write-seq config v out)]
+    [(cbor-tag? v) (cbor-write-tag config v out)] ; todo handle interpreted values
+    [(cbor-simple-value? v) (cbor-write-simple-value v out)]
     [else (error "Don't know how to write" v)]))
+
+(module* test #f
+  (require rackunit
+           "decode.rkt"
+           "private/test_data.rkt")
+
+  (define (try v)
+    (define out (open-output-bytes))
+    (cbor-write empty-config v out)
+    (get-output-bytes out))
+
+  (test-case
+      "Serialization - RFC 8949 Int and Bignum Examples"
+    (for ([pair (in-list int-bignum-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected))))
+
+  (test-case
+      "Serialization - RFC 8949 Bytestring and String Examples"
+    (for ([pair (in-list bytes-string-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected))))
+
+  (test-case
+      "Serialization - RFC 8949 List Examples"
+    (for ([pair (in-list list-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected))))
+
+  (test-case
+      "Serialization - RFC 8949 Map and Mixed Map/List Examples"
+    (for ([pair (in-list map-mixed-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected)))
+
+    ; hashes have unspecified ordering, just check that it round trips
+    (let* ([data #hash(("a" . "A") ("b" . "B") ("c" . "C") ("d" . "D") ("e" . "E"))]
+           [ser (try data)]
+           [data2 (cbor-read default-config (open-input-bytes ser))])
+      (check-equal? data2 data)))
+
+  (test-case
+      "Serialization - RFC 8949 Simple Value Examples"
+    (for ([pair (in-list simple-value-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected))))
+
+  )

@@ 0,0 1,73 @@
+#lang racket/base
+
+(require racket/list
+         racket/undefined
+         "../common.rkt"
+         "util.rkt")
+(provide bytes-string-examples int-bignum-examples simple-value-examples
+         list-examples map-mixed-examples)
+
+; vars here are lists of pairs (value, serialized form value)
+; this file is only used for data that round trips, i.e. can be used to test both
+; the serializer and deserializer. Tests specific to the encoder/decoder can be found
+; in the corresponding files.
+
+(define int-bignum-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       '((0 . "00")
+         (1 . "01")
+         (10 . "0a")
+         (23 . "17")
+         (24 . "1818")
+         (25 . "1819")
+         (100 . "1864")
+         (1000 . "1903e8")
+         (1000000 . "1a000f4240")
+         (1000000000000 . "1b000000e8d4a51000")
+         (18446744073709551615 . "1bffffffffffffffff")
+         #;(18446744073709551616 . "c249010000000000000000")
+         (-18446744073709551616 . "3bffffffffffffffff")
+         #;(-18446744073709551617 . "c349010000000000000000")
+         (-1 . "20")
+         (-10 . "29")
+         (-100 . "3863")
+         (-1000 . "3903e7"))))
+
+(define bytes-string-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       '((#"" . "40")
+         (#"\x01\x02\x03\x04" . "4401020304")
+         ("" . "60")
+         ("a" . "6161")
+         ("IETF" . "6449455446")
+         ("\"\\" . "62225c")
+         ("\u00fc" . "62c3bc")
+         ("\u6c34" . "63e6b0b4")
+         ("\ud800\udd51" . "64f0908591"))))
+
+(define simple-value-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       `((#f . "f4")
+         (#t . "f5")
+         (null . "f6")
+         (,undefined . "f7")
+         (,(cbor-simple-value 16) . "f0")
+         (,(cbor-simple-value 255) . "f8ff"))))
+
+(define list-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       `((() . "80")
+         ((1 2 3) . "83010203")
+         ((1 (2 3) (4 5)) . "8301820203820405")
+         (,(range 1 26) . "98190102030405060708090a0b0c0d0e0f101112131415161718181819"))))
+
+(define map-mixed-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       '((#hash() . "a0")
+         (#hash((1 . 2) (3 . 4)) . "a201020304")
+         (("a" #hash(("b" . "c"))) . "826161a161626163"))))

@@ 0,0 1,14 @@
+#lang racket/base
+
+(require racket/list)
+(provide hex-bytes)
+
+; Shorthand: (hex-bytes "0102030f") -> #"\x01\x02\x03\x0f"
+(define (hex-bytes s)
+  (if (not (even? (string-length s)))
+      (raise-argument-error "Must be even length string")
+      (list->bytes
+       (map (lambda (i)
+              (string->number (substring s (* 2 i) (+ (* 2 i) 2))
+                              16))
+            (range (/ (string-length s) 2))))))