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))