summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tests/frame.scm173
1 files changed, 173 insertions, 0 deletions
diff --git a/tests/frame.scm b/tests/frame.scm
new file mode 100644
index 0000000..5dd4813
--- /dev/null
+++ b/tests/frame.scm
@@ -0,0 +1,173 @@
+(define-module (test-frame)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
+ #:use-module (web socket frame))
+
+(define (hex-string->bytevector str)
+ "Convert the hexadecimal encoded string STR to a bytevector."
+ (define hex-char->int
+ (match-lambda
+ (#\0 0)
+ (#\1 1)
+ (#\2 2)
+ (#\3 3)
+ (#\4 4)
+ (#\5 5)
+ (#\6 6)
+ (#\7 7)
+ (#\8 8)
+ (#\9 9)
+ (#\a 10)
+ (#\b 11)
+ (#\c 12)
+ (#\d 13)
+ (#\e 14)
+ (#\f 15)))
+
+ (define (read-byte i)
+ (let ((j (* 2 i)))
+ (+ (hex-char->int (string-ref str (1+ j)))
+ (* (hex-char->int (string-ref str j)) 16))))
+
+ (let* ((len (/ (string-length str) 2))
+ (bv (make-bytevector len)))
+ (let loop ((i 0))
+ (if (= i len)
+ bv
+ (begin
+ (bytevector-u8-set! bv i (read-byte i))
+ (loop (1+ i)))))))
+
+(define (bytevector->hex-string bv)
+ (define int->hex-char
+ (match-lambda
+ (0 #\0)
+ (1 #\1)
+ (2 #\2)
+ (3 #\3)
+ (4 #\4)
+ (5 #\5)
+ (6 #\6)
+ (7 #\7)
+ (8 #\8)
+ (9 #\9)
+ (10 #\a)
+ (11 #\b)
+ (12 #\c)
+ (13 #\d)
+ (14 #\e)
+ (15 #\f)))
+
+ (list->string
+ (append-map (lambda (x)
+ (let ((high (ash (logand x #xf0) -4))
+ (low (logand x #x0f)))
+ (list (int->hex-char high)
+ (int->hex-char low))))
+ (bytevector->u8-list bv))))
+
+(define (call-with-input-bytevector bv proc)
+ (let ((port (open-bytevector-input-port bv)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (proc port))
+ (lambda ()
+ (close-port port)))))
+
+(define (frame->hex-string frame)
+ (call-with-values open-bytevector-output-port
+ (lambda (port get-bytevector)
+ (write-frame frame port)
+ (bytevector->hex-string (get-bytevector)))))
+
+(define (bytevector->frame bv)
+ (call-with-input-bytevector bv read-frame))
+
+(define (hex-string->frame str)
+ (bytevector->frame (hex-string->bytevector str)))
+
+(test-begin "frame")
+
+(test-equal "read unmasked text message"
+ (hex-string->frame "810548656c6c6f")
+ (make-text-frame "Hello"))
+
+(test-equal "write unmasked text message"
+ "810548656c6c6f"
+ (frame->hex-string (make-text-frame "Hello")))
+
+(test-equal "read masked text message"
+ (hex-string->frame "818537fa213d7f9f4d5158")
+ (make-text-frame "Hello" #vu8(#x37 #xfa #x21 #x3d)))
+
+(test-equal "write masked text message"
+ "818537fa213d7f9f4d5158"
+ (frame->hex-string (make-text-frame "Hello" #vu8(#x37 #xfa #x21 #x3d))))
+
+(test-equal "read fragmented umasked text message"
+ (list (hex-string->frame "010348656c")
+ (hex-string->frame "80026c6f"))
+ (list (make-frame #f 'text #f (string->utf8 "Hel"))
+ (make-frame #t 'continuation #f (string->utf8 "lo"))))
+
+(test-equal "read unmasked ping frame"
+ (hex-string->frame "890548656c6c6f")
+ (make-ping-frame (string->utf8 "Hello")))
+
+(test-equal "write unmasked ping frame"
+ "890548656c6c6f"
+ (frame->hex-string (make-ping-frame (string->utf8 "Hello"))))
+
+(test-equal "read masked pong frame"
+ (hex-string->frame "8a8537fa213d7f9f4d5158")
+ (make-pong-frame (string->utf8 "Hello") #vu8(#x37 #xfa #x21 #x3d)))
+
+(test-equal "write masked pong frame"
+ "8a8537fa213d7f9f4d5158"
+ (frame->hex-string
+ (make-pong-frame (string->utf8 "Hello") #vu8(#x37 #xfa #x21 #x3d))))
+
+(test-equal "read 256 bytes binary message in a single unmasked frame"
+ (let* ((header (hex-string->bytevector "827e0100"))
+ (len (bytevector-length header))
+ (frame (make-bytevector (+ len 256) 170)))
+ (bytevector-copy! header 0 frame 0 len)
+ (bytevector->frame frame))
+ (make-binary-frame (make-bytevector 256 170)))
+
+(test-equal "read 64KiB binary message in a single unmasked frame"
+ (let* ((header (hex-string->bytevector "827f0000000000010000"))
+ (len (bytevector-length header))
+ (frame (make-bytevector (+ len 65536) 170)))
+ (bytevector-copy! header 0 frame 0 len)
+ (bytevector->frame frame))
+ (make-binary-frame (make-bytevector 65536 170)))
+
+(test-equal "frame-length"
+ 10
+ (frame-length (make-binary-frame (make-bytevector 10))))
+
+(test-equal "frame-concatenate"
+ #vu8(1 2 3 4 5)
+ (frame-concatenate
+ (list (make-binary-frame #vu8(1 2 3))
+ (make-binary-frame #vu8(4 5)))))
+
+(test-equal "text-frame->string"
+ "Hello"
+ (text-frame->string (make-text-frame "Hello")))
+
+(test-equal "text-frames->string"
+ "Hello"
+ (text-frames->string
+ (list (make-text-frame "Hel")
+ (make-text-frame "lo"))))
+
+(test-end "frame")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))