diff options
| -rw-r--r-- | tests/frame.scm | 173 |
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)) |