Support detection of short inputs, for e.g. incremental parsing use

implementations/racket/preserves/main.rkt

@@ -29,8 +29,11 @@
 (define (encode v)
   (bit-string->bytes (bit-string (v :: (wire-value)))))
 
-(define (decode bs [on-fail (lambda () (error 'decode "Invalid encoding: ~v" bs))])
+(define (decode bs
+                #:on-short [on-short (lambda () (error 'decode "Short encoding: ~v" bs))]
+                [on-fail (lambda () (error 'decode "Invalid encoding: ~v" bs))])
   (bit-string-case bs
+    #:on-short (lambda (fail) (on-short))
     ([ (v :: (wire-value)) ] v)
     (else (on-fail))))
 
@@ -138,6 +141,7 @@
 
 (define (decode-wire-length bs ks kf)
   (bit-string-case bs
+    #:on-short (lambda (fail) (kf #t))
     ([ (= #b1111 :: bits 4) (rest :: binary) ]
      (decode-varint rest
                     (lambda (v tail)
@@ -150,6 +154,7 @@
 
 (define (decode-varint bs ks kf)
   (bit-string-case bs
+    #:on-short (lambda (fail) (kf #t))
     ([ (= 1 :: bits 1) (v :: bits 7) (rest :: binary) ]
      (decode-varint rest (lambda (acc tail) (ks (+ (* acc 128) v) tail)) kf))
     ([ (= 0 :: bits 1) (v :: bits 7) (rest :: binary) ]
@@ -161,6 +166,7 @@
   (if (zero? n)
       (ks (reverse acc-rev) bs)
       (bit-string-case bs
+        #:on-short (lambda (fail) (kf #t))
         ([ (v :: (wire-value)) (rest :: binary) ]
          (decode-values (- n 1) (cons v acc-rev) rest ks kf))
         (else (kf)))))
@@ -198,6 +204,7 @@
 (define (decode-stream major minor chunk-ok? join-chunks decode rest ks kf)
   (let loop ((acc-rev '()) (rest rest))
     (bit-string-case rest
+      #:on-short (lambda (fail) (kf #t))
       ([ (= #b0011 :: bits 4) (emajor :: bits 2) (eminor :: bits 2) (rest :: binary) ]
        (if (and (= major emajor) (= minor eminor))
            (decode minor (join-chunks (reverse acc-rev)) rest ks kf)
@@ -212,6 +219,7 @@
 
 (define (decode-value bs ks kf)
   (bit-string-case bs
+    #:on-short (lambda (fail) (kf #t))
     ([ (= #b00000000 :: bits 8) (rest :: binary) ] (ks #f rest))
     ([ (= #b00000001 :: bits 8) (rest :: binary) ] (ks #t rest))
     ([ (= #b00000010 :: bits 8) (v :: float bits 32) (rest :: binary) ] (ks (real->single-flonum v) rest))
@@ -519,12 +527,13 @@
   (check-equal? (bit-string->bytes (encode-varint 1000000000)) (bytes 128 148 235 220 3))
 
   (define (ks* v rest) (list v (bit-string->bytes rest)))
-  (define (kf*) (void))
+  (define (kf* [short? #f]) (if short? 'short (void)))
 
   (check-equal? (decode-varint (bytes 0) ks* kf*) (list 0 (bytes)))
   (check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99)))
   (check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes)))
   (check-equal? (decode-varint (bytes 127) ks* kf*) (list 127 (bytes)))
+  (check-equal? (decode-varint (bytes 128) ks* kf*) 'short)
   (check-equal? (decode-varint (bytes 128 1) ks* kf*) (list 128 (bytes)))
   (check-equal? (decode-varint (bytes 128 1 99) ks* kf*) (list 128 (bytes 99)))
   (check-equal? (decode-varint (bytes 255 1) ks* kf*) (list 255 (bytes)))
@@ -544,17 +553,19 @@
 
   (define (dwl bs)
     (bit-string-case bs
+      #:on-short (lambda (fail) 'short)
       ([ (= 0 :: bits 4) (w :: (wire-length)) ] w)
       (else (void))))
 
   (check-equal? (dwl (bytes 0)) 0)
   (check-equal? (dwl (bytes 3)) 3)
   (check-equal? (dwl (bytes 14)) 14)
-  (check-equal? (dwl (bytes 15)) (void))
+  (check-equal? (dwl (bytes 15)) 'short)
   (check-equal? (dwl (bytes 15 9)) (void)) ;; not canonical
   (check-equal? (dwl (bytes 15 15)) 15)
   (check-equal? (dwl (bytes 15 100)) 100)
   (check-equal? (dwl (bytes 15 #b10101100 #b00000010)) 300)
+  (check-equal? (dwl (bytes 15 #b10101100)) 'short)
 
   (struct speak (who what) #:prefab)
 
@@ -567,7 +578,16 @@
                    [(? string? s) (string->bytes/utf-8 s)])
                  pieces))))
 
-  (define (d bs) (decode bs void))
+  (define (d bs)
+    (for [(i (in-range 0 (- (bytes-length bs) 1)))]
+      (when (not (eq? (decode (subbytes bs 0 i)
+                              #:on-short (lambda () 'short)
+                              void)
+                      'short))
+        (error 'd "~a-byte prefix of ~v does not read as short" i bs)))
+    (decode bs
+            #:on-short (lambda () 'short)
+            void))
 
   (define-syntax (cross-check stx)
     (syntax-case stx ()
@@ -766,8 +786,8 @@
 
   (cross-check "[abc ... def]" (list 'abc '|...| 'def) (#xC3 #x73 "abc" #x73 "..." #x73 "def"))
 
-  (check-equal? (d (expected #x2C #x00 #x00)) (void)) ;; missing end byte
-  (check-equal? (d (expected #xC3 #x00 #x00)) (void)) ;; missing element
+  (check-equal? (d (expected #x2C #x00 #x00)) 'short) ;; missing end byte
+  (check-equal? (d (expected #xC3 #x00 #x00)) 'short) ;; missing element
 
   (cross-check/nondeterministic
    "{a: 1, \"b\": #true, [1 2 3]: #\"c\", {first-name:\"Elizabeth\"}:{surname:\"Blackwell\"}}"