blob: 9d5befed4176fbc5420c80c1a907ab1b7faee490 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; Weeb --- Web microframework for GNU Guile
;;; Copyright © 2026 Jakob Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This file is part of Weeb.
;;;
;;; Weeb is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Weeb is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;;; Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.
(use-modules (srfi srfi-11)
(srfi srfi-64)
(weeb request)
(weeb response)
(weeb router)
(weeb struct))
;; Private imports for testing purposes.
(define uri-template->regexp-string
(@@ (weeb router) uri-template->regexp-string))
(define handle-route
(@@ (weeb router) handle-route))
(test-runner-current (test-runner-simple))
(test-begin "weeb-router")
(test-group "simple static route"
(let-values (((re vars) (uri-template->regexp-string "/health")))
(test-equal "^/health$" re)
(test-equal '() vars)))
(test-group "single variable route"
(let-values (((re vars) (uri-template->regexp-string "/user/:id:")))
(test-equal "^/user/([^/]+)$" re)
(test-equal '(id) vars)))
(test-group "multiple variables with trailing slash"
(let-values (((re vars) (uri-template->regexp-string "/org/:org_id:/user/:user_id:/")))
(test-equal "^/org/([^/]+)/user/([^/]+)/?$" re)
(test-equal '(org_id user_id) vars)))
(test-group "middle variables"
(let-values (((re vars) (uri-template->regexp-string "/api/:version:/data")))
(test-equal "^/api/([^/]+)/data$" re)
(test-equal '(version) vars)))
(test-group "handle route"
(define (handler r id)
(list id))
(define-router router
("/user/:id:" (GET) handler))
(let* ((req (make-struct <request> 'GET "/user/123" #f #f #f))
(route-obj (car router)))
(test-equal '("123") (handle-route req route-obj)))
(let ((req (make-struct <request> 'POST "/user/123" #f #f #f))
(route-obj (car router)))
(test-eqv #f (handle-route req route-obj))))
(test-group "iter-routes 1"
(define (static-handler r) "static")
(define (api-handler r version) (list version))
(define-router router
("/static/" (GET) static-handler)
("/api/:version:/data" (GET) api-handler))
(let ((req (make-struct <request> 'GET "/api/v1/data" #f #f #f)))
(test-equal '("v1") (iter-routes req router))))
(test-group "iter-routes 2"
(define (handler r org_id user_id) (list org_id user_id))
(define-router router
("/org/:org_id:/user/:user_id:/" (GET) handler))
(let ((req (make-struct <request> 'GET "/org/42/user/99/" #f #f #f)))
(test-equal '("42" "99") (iter-routes req router))))
(test-group "edge cases 1"
(define (handler request) "ok")
(define-router router
("/health" (GET) handler))
(let ((req (make-struct <request> 'GET "/health" #f #f #f)))
(test-equal "ok" (iter-routes req router))))
(test-group "edge cases 2"
(define (handler request) "home")
(define-router router
("/" (GET) handler))
(let ((req (make-struct <request> 'GET "/" #f #f #f)))
(test-equal "home" (iter-routes req router))))
(test-group "edge cases 3: anchor validation"
(define-router router
("/health" (GET) (lambda (r) "ok"))
("/user/:id:" (GET) (lambda (r id) id))
("/" (GET) (lambda (r) "home")))
(let* ((req (make-struct <request> 'GET "/health/extra" #f #f #f))
(res (any->response (iter-routes req router))))
(with-accessors (res code) (test-eqv 404 code)))
(let* ((req (make-struct <request> 'GET "/user/123/extra" #f #f #f))
(res (any->response (iter-routes req router))))
(with-accessors (res code) (test-eqv 404 code)))
(let* ((req (make-struct <request> 'GET "/anything" #f #f #f))
(res (any->response (iter-routes req router))))
(with-accessors (res code) (test-eqv 404 code))))
(test-end)
|
© 2015 - 2026 Jakob L. Kreuze
