test/test-server.sgl — sigil-websocket

1(import (sigil test)

2 (sigil string)

3 (sigil math)

4 (sigil websocket frame)

5 (sigil websocket server))

7;; ============================================================

8;; compute-accept-key — RFC 6455 §1.3 test vector

9;; ============================================================

11(test-group "compute-accept-key"

12 (test "matches RFC 6455 example"

13 ;; Spec test vector: key "dGhlIHNhbXBsZSBub25jZQ==" produces

14 ;; accept "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="

15 (assert-equal "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="

16 (compute-accept-key "dGhlIHNhbXBsZSBub25jZQ=="))))

18;; ============================================================

19;; handshake-request-bytes-needed?

20;; ============================================================

22(test-group "handshake-request-bytes-needed?"

23 (test "incomplete request needs more bytes"

24 (assert-true (handshake-request-bytes-needed? "GET /ws HTTP/1.1\r\n"))

25 (assert-true (handshake-request-bytes-needed?

26 "GET /ws HTTP/1.1\r\nHost: x\r\n")))

28 (test "complete request does not need more"

29 (assert-false (handshake-request-bytes-needed?

30 (string-append

31 "GET /ws HTTP/1.1\r\n"

32 "Host: x\r\n"

33 "Upgrade: websocket\r\n"

34 "Connection: Upgrade\r\n"

35 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

36 "Sec-WebSocket-Version: 13\r\n"

37 "\r\n")))))

39;; ============================================================

40;; parse-handshake-request

41;; ============================================================

43(define (good-request)

44 (string-append

45 "GET /ws HTTP/1.1\r\n"

46 "Host: enclave.example\r\n"

47 "Upgrade: websocket\r\n"

48 "Connection: Upgrade\r\n"

49 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

50 "Sec-WebSocket-Version: 13\r\n"

51 "Sec-WebSocket-Protocol: text.ircv3.net, binary.ircv3.net\r\n"

52 "X-Forwarded-For: 198.51.100.7, 10.0.0.1\r\n"

53 "\r\n"))

55(test-group "parse-handshake-request"

56 (test "parses a valid request"

57 (let ((req (parse-handshake-request (good-request))))

58 (assert-true (ws-handshake-request? req))

59 (assert-equal "GET" (ws-handshake-request-method req))

60 (assert-equal "/ws" (ws-handshake-request-path req))

61 (assert-equal "enclave.example" (ws-handshake-request-host req))

62 (assert-equal "dGhlIHNhbXBsZSBub25jZQ==" (ws-handshake-request-key req))

63 (assert-equal 13 (ws-handshake-request-version req))

64 (assert-equal '("text.ircv3.net" "binary.ircv3.net")

65 (ws-handshake-request-subprotocols req))

66 (assert-equal "198.51.100.7"

67 (ws-handshake-request-x-forwarded-for req))))

69 (test "missing Upgrade -> 426"

70 (let ((req (parse-handshake-request

71 (string-append

72 "GET / HTTP/1.1\r\n"

73 "Host: x\r\n"

74 "Connection: Upgrade\r\n"

75 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

76 "Sec-WebSocket-Version: 13\r\n"

77 "\r\n"))))

78 (assert-true (ws-handshake-error? req))

79 (assert-equal 426 (ws-handshake-error-status req))))

81 (test "wrong version -> 426"

82 (let ((req (parse-handshake-request

83 (string-append

84 "GET / HTTP/1.1\r\n"

85 "Host: x\r\n"

86 "Upgrade: websocket\r\n"

87 "Connection: Upgrade\r\n"

88 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

89 "Sec-WebSocket-Version: 8\r\n"

90 "\r\n"))))

91 (assert-true (ws-handshake-error? req))

92 (assert-equal 426 (ws-handshake-error-status req))))

94 (test "POST -> 405"

95 (let ((req (parse-handshake-request

96 (string-append

97 "POST /ws HTTP/1.1\r\n"

98 "Host: x\r\n"

99 "Upgrade: websocket\r\n"

100 "Connection: Upgrade\r\n"

101 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

102 "Sec-WebSocket-Version: 13\r\n"

103 "\r\n"))))

104 (assert-true (ws-handshake-error? req))

105 (assert-equal 405 (ws-handshake-error-status req))))

106

107 (test "missing key -> 400"

108 (let ((req (parse-handshake-request

109 (string-append

110 "GET / HTTP/1.1\r\n"

111 "Host: x\r\n"

112 "Upgrade: websocket\r\n"

113 "Connection: Upgrade\r\n"

114 "Sec-WebSocket-Version: 13\r\n"

115 "\r\n"))))

116 (assert-true (ws-handshake-error? req))

117 (assert-equal 400 (ws-handshake-error-status req)))))

118

119;; ============================================================

120;; build-handshake-response

121;; ============================================================

122

123(test-group "build-handshake-response"

124 (test "writes 101 with correct accept"

125 (let* ((req (parse-handshake-request (good-request)))

126 (resp (build-handshake-response req)))

127 (assert-true

128 (string-contains? resp "HTTP/1.1 101 Switching Protocols\r\n"))

129 (assert-true

130 (string-contains? resp

131 "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=\r\n"))

132 (assert-true

133 (string-contains? resp "Upgrade: websocket\r\n"))

134 (assert-true

135 (string-contains? resp "Connection: Upgrade\r\n"))))

136

137 (test "echoes negotiated subprotocol"

138 (let* ((req (parse-handshake-request (good-request)))

139 (resp (build-handshake-response req

140 subprotocol: "text.ircv3.net")))

141 (assert-true

142 (string-contains? resp

143 "Sec-WebSocket-Protocol: text.ircv3.net\r\n")))))

144

145;; ============================================================

146;; build-handshake-error-response

147;; ============================================================

148

149(test-group "build-handshake-error-response"

150 (test "426 includes Upgrade hint"

151 (let* ((err (parse-handshake-request

152 (string-append

153 "GET / HTTP/1.1\r\n"

154 "Host: x\r\n"

155 "Connection: Upgrade\r\n"

156 "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"

157 "Sec-WebSocket-Version: 13\r\n"

158 "\r\n")))

159 (resp (build-handshake-error-response err)))

160 (assert-true (string-contains? resp "HTTP/1.1 426"))

161 (assert-true (string-contains? resp "Upgrade: websocket\r\n"))

162 (assert-true (string-contains? resp "Sec-WebSocket-Version: 13\r\n")))))

163

164;; ============================================================

165;; Server-side frame encoders are unmasked

166;; ============================================================

167

168(test-group "server-side frame encoders"

169 (test "encode-server-text-frame is unmasked and round-trips"

170 (let* ((encoded (encode-server-text-frame "PRIVMSG #hive :hi"))

171 (result (decode-frame encoded))

172 (frame (frame-decode-result-frame result)))

173 (assert-true (ws-frame? frame))

174 (assert-equal opcode-text (ws-frame-opcode frame))

175 (assert-true (ws-frame-fin? frame))

176 ;; Mask bit must be 0 — verify by checking byte 1's high bit.

177 (assert-equal 0 (bitwise-and (bytevector-u8-ref encoded 1) #x80))))

178

179 (test "encode-server-pong-frame is unmasked"

180 (let ((encoded (encode-server-pong-frame (make-bytevector 0))))

181 (assert-equal opcode-pong (bitwise-and (bytevector-u8-ref encoded 0) #x0F))

182 (assert-equal 0 (bitwise-and (bytevector-u8-ref encoded 1) #x80))))

183

184 (test "encode-server-close-frame includes status code"

185 (let* ((encoded (encode-server-close-frame 1000))

186 (result (decode-frame encoded))

187 (frame (frame-decode-result-frame result))

188 (payload (ws-frame-payload frame)))

189 (assert-equal opcode-close (ws-frame-opcode frame))

190 (assert-equal 2 (bytevector-length payload))

191 (assert-equal #x03 (bytevector-u8-ref payload 0)) ; 1000 >> 8

192 (assert-equal #xE8 (bytevector-u8-ref payload 1))))) ; 1000 & 0xFF

193

194(run-tests)