test/test-request.sgl

1;;; Test suite for (sigil http request)

3(import (sigil test)

4 (sigil http request))

6;; ============================================================

7;;; Request Line Parsing Tests

8;; ============================================================

10(test "parse simple GET request line"

11 (let ((result (parse-request-line "GET /path HTTP/1.1")))

12 (assert-true result)

13 (assert-equal (car result) 'GET)

14 (assert-equal (cadr result) "/path")

15 (assert-equal (caddr result) #f) ; no query

16 (assert-equal (cadddr result) "HTTP/1.1")))

18(test "parse GET request line with query string"

19 (let ((result (parse-request-line "GET /search?q=hello&page=1 HTTP/1.1")))

20 (assert-true result)

21 (assert-equal (car result) 'GET)

22 (assert-equal (cadr result) "/search")

23 (assert-equal (caddr result) "q=hello&page=1")

24 (assert-equal (cadddr result) "HTTP/1.1")))

26(test "parse POST request line"

27 (let ((result (parse-request-line "POST /api/users HTTP/1.1")))

28 (assert-true result)

29 (assert-equal (car result) 'POST)

30 (assert-equal (cadr result) "/api/users")))

32(test "parse various HTTP methods"

33 (assert-equal (car (parse-request-line "PUT /resource HTTP/1.1")) 'PUT)

34 (assert-equal (car (parse-request-line "DELETE /resource HTTP/1.1")) 'DELETE)

35 (assert-equal (car (parse-request-line "HEAD /resource HTTP/1.1")) 'HEAD)

36 (assert-equal (car (parse-request-line "OPTIONS /resource HTTP/1.1")) 'OPTIONS)

37 (assert-equal (car (parse-request-line "PATCH /resource HTTP/1.1")) 'PATCH))

39(test "parse request line with HTTP/1.0"

40 (let ((result (parse-request-line "GET / HTTP/1.0")))

41 (assert-true result)

42 (assert-equal (cadddr result) "HTTP/1.0")))

44(test "reject invalid request line - missing parts"

45 (assert-false (parse-request-line "GET /path"))

46 (assert-false (parse-request-line "GET"))

47 (assert-false (parse-request-line "")))

49(test "reject invalid request line - unknown method"

50 (assert-false (parse-request-line "INVALID /path HTTP/1.1")))

52;; ============================================================

53;;; Request Record Tests

54;; ============================================================

56(test "create request with all fields"

57 (let ((req (http-request

58 method: 'GET

59 path: "/test"

60 query: "foo=bar"

61 version: "HTTP/1.1"

62 headers: #{ host: "example.com" }

63 body: #f)))

64 (assert-equal (http-request-method req) 'GET)

65 (assert-equal (http-request-path req) "/test")

66 (assert-equal (http-request-query req) "foo=bar")

67 (assert-equal (http-request-version req) "HTTP/1.1")

68 (assert-equal (http-request-body req) #f)))

70(test "request context defaults to empty dict"

71 (let ((req (http-request

72 method: 'GET

73 path: "/"

74 query: #f

75 version: "HTTP/1.1"

76 headers: #{}

77 body: #f)))

78 (assert-true (dict? (http-request-context req)))

79 (assert-true (dict-empty? (http-request-context req)))))

81;; ============================================================

82;;; Header Lookup Tests

83;; ============================================================

85(test "header lookup is case-insensitive"

86 (let ((req (http-request

87 method: 'GET

88 path: "/"

89 query: #f

90 version: "HTTP/1.1"

91 headers: #{ content-type: "text/html"

92 x-custom-header: "value" }

93 body: #f)))

94 (assert-equal (http-request-header req "Content-Type") "text/html")

95 (assert-equal (http-request-header req "content-type") "text/html")

96 (assert-equal (http-request-header req "CONTENT-TYPE") "text/html")

97 (assert-equal (http-request-header req "x-custom-header") "value")))

99(test "header lookup returns #f for missing header"

100 (let ((req (http-request

101 method: 'GET

102 path: "/"

103 query: #f

104 version: "HTTP/1.1"

105 headers: #{ host: "example.com" }

106 body: #f)))

107 (assert-false (http-request-header req "Content-Type"))

108 (assert-false (http-request-header req "X-Missing"))))

109

110;; ============================================================

111;;; URI Construction Tests

112;; ============================================================

113

114(test "uri without query string"

115 (let ((req (http-request

116 method: 'GET

117 path: "/path/to/resource"

118 query: #f

119 version: "HTTP/1.1"

120 headers: #{}

121 body: #f)))

122 (assert-equal (http-request-uri req) "/path/to/resource")))

123

124(test "uri with query string"

125 (let ((req (http-request

126 method: 'GET

127 path: "/search"

128 query: "q=test&limit=10"

129 version: "HTTP/1.1"

130 headers: #{}

131 body: #f)))

132 (assert-equal (http-request-uri req) "/search?q=test&limit=10")))

133

134;; ============================================================

135;;; Content-Length and Content-Type Tests

136;; ============================================================

137

138(test "content-length parsing"

139 (let ((req (http-request

140 method: 'POST

141 path: "/"

142 query: #f

143 version: "HTTP/1.1"

144 headers: #{ content-length: "42" }

145 body: #f)))

146 (assert-equal (http-request-content-length req) 42)))

147

148(test "content-length returns #f when missing"

149 (let ((req (http-request

150 method: 'GET

151 path: "/"

152 query: #f

153 version: "HTTP/1.1"

154 headers: #{}

155 body: #f)))

156 (assert-false (http-request-content-length req))))

157

158(test "content-type retrieval"

159 (let ((req (http-request

160 method: 'POST

161 path: "/"

162 query: #f

163 version: "HTTP/1.1"

164 headers: #{ content-type: "application/json" }

165 body: #f)))

166 (assert-equal (http-request-content-type req) "application/json")))

167

168;; ============================================================

169;;; Context Tests

170;; ============================================================

171

172(test "context-ref returns value for existing key"

173 (let ((req (http-request

174 method: 'GET

175 path: "/"

176 query: #f

177 version: "HTTP/1.1"

178 headers: #{}

179 body: #f

180 context: #{ user: "alice" role: "admin" })))

181 (assert-equal (http-request-context-ref req user:) "alice")

182 (assert-equal (http-request-context-ref req role:) "admin")))

183

184(test "context-ref returns #f for missing key"

185 (let ((req (http-request

186 method: 'GET

187 path: "/"

188 query: #f

189 version: "HTTP/1.1"

190 headers: #{}

191 body: #f)))

192 (assert-false (http-request-context-ref req missing:))))

193

194(test "context-ref returns default for missing key"

195 (let ((req (http-request

196 method: 'GET

197 path: "/"

198 query: #f

199 version: "HTTP/1.1"

200 headers: #{}

201 body: #f)))

202 (assert-equal (http-request-context-ref req missing: "default") "default")))

203

204(test "with-context adds to context immutably"

205 (let* ((req1 (http-request

206 method: 'GET

207 path: "/"

208 query: #f

209 version: "HTTP/1.1"

210 headers: #{}

211 body: #f))

212 (req2 (http-request-with-context req1 user: "alice")))

213 ;; Original unchanged

214 (assert-false (http-request-context-ref req1 user:))

215 ;; New request has context

216 (assert-equal (http-request-context-ref req2 user:) "alice")

217 ;; Other fields preserved

218 (assert-equal (http-request-method req2) 'GET)

219 (assert-equal (http-request-path req2) "/")))

220

221;; ============================================================

222;; URL Encoding Tests

223;; ============================================================

224

225(test "url-encode-value passes unreserved characters through"

226 (assert-equal (url-encode-value "hello") "hello")

227 (assert-equal (url-encode-value "Test123") "Test123")

228 (assert-equal (url-encode-value "a-b_c.d~e") "a-b_c.d~e"))

229

230(test "url-encode-value encodes spaces as +"

231 (assert-equal (url-encode-value "hello world") "hello+world")

232 (assert-equal (url-encode-value "a b c") "a+b+c"))

233

234(test "url-encode-value encodes special characters"

235 (assert-equal (url-encode-value "a&b") "a%26b")

236 (assert-equal (url-encode-value "a=b") "a%3Db")

237 (assert-equal (url-encode-value "a+b") "a%2Bb")

238 (assert-equal (url-encode-value "100%") "100%25"))

239

240(test "url-encode-value encodes unicode as UTF-8 bytes"

241 (assert-equal (url-encode-value "café") "caf%C3%A9")

242 (assert-equal (url-encode-value "日本") "%E6%97%A5%E6%9C%AC"))

243

244(test "url-encode-value handles empty string"

245 (assert-equal (url-encode-value "") ""))

246

247(test "url-encode-value encodes path-like characters"

248 (assert-equal (url-encode-value "/foo/bar") "%2Ffoo%2Fbar")

249 (assert-equal (url-encode-value "a?b") "a%3Fb"))

250

251;; ============================================================

252;; Query String Building Tests

253;; ============================================================

254

255(test "build-query-string with simple pairs"

256 (assert-equal (build-query-string '(("q" . "hello") ("page" . "1")))

257 "?q=hello&page=1"))

258

259(test "build-query-string encodes values"

260 (assert-equal (build-query-string '(("q" . "hello world")))

261 "?q=hello+world"))

262

263(test "build-query-string encodes keys"

264 (assert-equal (build-query-string '(("my key" . "val")))

265 "?my+key=val"))

266

267(test "build-query-string omits pairs with #f values"

268 (assert-equal (build-query-string '(("q" . "test") ("lang" . #f)))

269 "?q=test"))

270

271(test "build-query-string returns empty string for empty list"

272 (assert-equal (build-query-string '()) ""))

273

274(test "build-query-string returns empty string when all values are #f"

275 (assert-equal (build-query-string '(("a" . #f) ("b" . #f))) ""))

276

277(test "build-query-string handles special characters in values"

278 (assert-equal (build-query-string '(("url" . "https://example.com")))

279 "?url=https%3A%2F%2Fexample.com"))

280

281;; ============================================================

282;;; build-repeated-params

283;; ============================================================

284

285(test-group "build-repeated-params"

286

287 (test "single value"

288 (assert-equal (build-repeated-params "id" '("123")) "id=123"))

289

290 (test "multiple values"

291 (assert-equal (build-repeated-params "id" '("123" "456" "789"))

292 "id=123&id=456&id=789"))

293

294 (test "encodes special characters"

295 (assert-equal (build-repeated-params "q" '("hello world"))

296 "q=hello+world")))

297

298

299;; ============================================================

300;;; ensure-list

301;; ============================================================

302

303(test-group "ensure-list"

304

305 (test "wraps string in list"

306 (assert-equal (ensure-list "hello") '("hello")))

307

308 (test "passes list through"

309 (assert-equal (ensure-list '("a" "b")) '("a" "b")))

310

311 (test "passes empty list through"

312 (assert-equal (ensure-list '()) '())))

313

314

315(run-tests)