-
Notifications
You must be signed in to change notification settings - Fork 0
/
codec-tests.ss
164 lines (135 loc) · 7.6 KB
/
codec-tests.ss
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
#lang scheme/base
(require "test-base.ss")
(require net/uri-codec
srfi/19
(mirrors-in)
(unlib-in time)
"main.ss")
(require/expose web-server/dispatchers/dispatch
(exn:dispatcher?))
(require/expose "codec.ss"
(clean-request-url))
; Test data --------------------------------------
(define-site math
([("/divide/" (integer-arg) "/" (integer-arg)) divide-numbers]
[("/add/" (integer-arg) "/" (integer-arg)) add-numbers]
[("/subtract/" (integer-arg) "/" (integer-arg)) subtract-numbers]
[("/and/" (boolean-arg) "/" (boolean-arg)) and-booleans]
[("/after/" (time-utc-arg "~Y~m~d") "/" (time-utc-arg "~Y~m~d")) time-after]))
; request integer integer -> real
(define-controller (divide-numbers request num den)
#:access? (not (zero? den))
(/ num den))
; request integer integer -> integer
(define-controller (add-numbers request first second)
(+ first second))
; Leave subtract-numbers undefined.
; request boolean boolean -> boolean
(define-controller (and-booleans request first second)
(if (and (boolean? first) (boolean? second))
(and first second)
(raise-type-error #f "booleans" (list first second))))
; request time-utc time-utc -> boolean
(define-controller (time-after request first second)
(if (and (time-utc? first) (time-utc? second))
(time>? first second)
(raise-type-error #f "time-utcs" (list first second))))
; Tests ------------------------------------------
(define/provide-test-suite codec-tests
(test-equal? "clean-request-url"
(clean-request-url (test-request (format "/~a/~a/" (uri-encode "a/b") (uri-encode "c?d"))))
(format "/~a/~a/" (uri-encode "a/b") (uri-encode "c?d")))
(test-case "site-dispatch : divide-numbers"
(check-equal? (site-dispatch math (test-request "/divide/8/2")) 4)
(check-equal? (site-dispatch math (test-request "/divide/8/4")) 2))
(test-case "site-dispatch : add-numbers"
(check-equal? (site-dispatch math (test-request "/add/1/2")) 3))
(test-case "site-dispatch : controller undefined"
(check-pred response/full? (site-dispatch math (test-request "/subtract/1/2")))
(parameterize ([default-controller-undefined-responder
(lambda (controller request . args)
(cons (controller-id controller) args))])
(check-equal? (site-dispatch math (test-request "/subtract/1/2"))
'(subtract-numbers 1 2))))
(test-case "site-dispatch : access denied"
(check-pred response/full? (site-dispatch math (test-request "/divide/8/0")))
(parameterize ([default-access-denied-responder
(lambda (controller request . args)
(cons (controller-id controller) args))])
(check-equal? (site-dispatch math (test-request "/divide/8/0"))
'(divide-numbers 8 0))))
(test-case "site-dispatch : controller not found"
; We can't use check-exn because exn:dispatcher isn't actually an exn:
(check-true (with-handlers ([exn:dispatcher? (lambda _ #t)])
(site-dispatch math (test-request "/undefined"))
#f)))
(test-case "site-dispatch : anchor / query string / url-params"
(check-equal? (site-dispatch math (test-request "/divide/8/2#anchor")) 4)
(check-equal? (site-dispatch math (test-request "/divide/8/4;((a . b))")) 2)
(check-equal? (site-dispatch math (test-request "/divide/8/8?a=b&c=d")) 1))
(test-case "controller-url : divide-numbers"
(check-equal? (controller-url divide-numbers 8 2) "/divide/8/2")
(check-equal? (controller-url divide-numbers 8 4) "/divide/8/4"))
(test-case "controller-url : add-numbers"
(check-equal? (controller-url add-numbers 1 2) "/add/1/2"))
(test-case "controller-access? : divide-numbers"
(check-true (controller-access? divide-numbers (test-request "foo") 8 2))
(check-false (controller-access? divide-numbers (test-request "foo") 8 0)))
(test-case "controller-link : no arguments"
(let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 4)]
[mirrors (link-ref)]
[sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
[sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
(check-pred xml? mirrors)
(check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\">/divide/8/4</a>")
(check-equal? sexp '(a ([href "/divide/8/4"]) "/divide/8/4"))
(check-equal? sexps '((a ([href "/divide/8/4"]) "/divide/8/4")))))
(test-case "controller-link : all arguments"
(let* ([link-ref (lambda (body)
(controller-link
divide-numbers
(test-request "foo") 8 4
#:id 'id
#:class 'class
#:target "_new"
#:title "title"
#:body body))]
[mirrors (link-ref "body")]
[sexp (parameterize ([default-link-format 'sexp]) (link-ref "body"))]
[sexps (parameterize ([default-link-format 'sexps]) (link-ref '("body")))])
(check-pred xml? mirrors)
(check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\" id=\"id\" class=\"class\" target=\"_new\" title=\"title\">body</a>")
(check-equal? sexp '(a ([href "/divide/8/4"] [id "id"] [class "class"] [target "_new"] [title "title"]) "body"))
(check-equal? sexps '((a ([href "/divide/8/4"] [id "id"] [class "class"] [target "_new"] [title "title"]) "body")))))
(test-case "controller-link : no access : hide"
(let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'hide)]
[mirrors (link-ref)]
[sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
[sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
(check-pred xml? mirrors)
(check-pred xml-empty? mirrors)
(check-equal? sexp '(span))
(check-equal? sexps null)))
(test-case "controller-link : no access : span"
(let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'span #:id 'id #:class 'class #:title "title")]
[mirrors (link-ref)]
[sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
[sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
(check-pred xml? mirrors)
(check-equal? (xml->string mirrors) "<span id=\"id\" class=\"no-access-link class\" title=\"title\">/divide/8/0</span>")
(check-equal? sexp '(span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0"))
(check-equal? sexps '((span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0")))))
(test-case "controller-link : no access : body"
(let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'body)]
[mirrors (link-ref)]
[sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
[sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
(check-pred xml? mirrors)
(check-equal? (xml->string mirrors) "/divide/8/0")
(check-equal? sexp "/divide/8/0")
(check-equal? sexps '("/divide/8/0"))))
(test-case "default-controller-wrapper"
(parameterize ([default-controller-wrapper
(lambda (controller request . args)
(add1 (apply (controller-body-proc controller) request args)))])
(check-equal? (site-dispatch math (test-request "/divide/8/2")) 5))))