add tests for register-temp-stanza-handler-for-id
[software/gnubba.git] / spec / xmpp.scm
1 (use-modules (gnubba xmpp))
2
3 (suite "iq/message/presence stanzas"
4 (tests
5 (test "iq should return a simple iq stanza" e
6 (assert-equal '(*TOP* (iq (@ (to "romeo@capulet.it")
7 (type "get")
8 (id "1234"))
9 "payload"))
10 (e 'iq1)))
11 (test "message should return a simple message stanza" e
12 (assert-equal '(*TOP* (message (@ (to "romeo@capulet.it"))
13 (body "hello, romeo!")))
14 (e 'message1)))
15 (test "presence should return a simple presence stanza" e
16 (assert-equal '(*TOP* (presence (@ (id "1234"))))
17 (e 'presence1)))
18 (test "presence takes optional body argument" e
19 (assert-equal '(*TOP* (presence (@ (id "1234")) "body"))
20 (e 'presence2)))
21 (test "iq? should return #t on an iq stanza" e
22 (assert-true (iq? (e 'iq1))))
23 (test "iq? should return #f on any other stanza" e
24 (assert-false (iq? (e 'message1))))
25 (test "message? should return #t on a message stanza" e
26 (assert-true (message? (e 'message1))))
27 (test "message? should return #f on any other stanza" e
28 (assert-false (message? (e 'iq1))))
29 (test "presence? should return #t on a presence stanza" e
30 (assert-true (presence? (e 'presence1))))
31 (test "presence? should return #f on any other stanza" e
32 (assert-false (presence? (e 'iq1)))))
33 (options)
34 (setups
35 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
36 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
37 (setup 'presence1 (presence #:id "1234"))
38 (setup 'presence2 (presence "body" #:id "1234"))
39 (setup 'presence3 (presence "body" #:id "1234" #:from "romeo@capulet.it"))))
40
41 (suite "register-temp-stanza-handler-for-id"
42 (tests
43 (test "handler is not executed if stanza with non-matching id is received" e
44 (assert-false (error?
45 (begin
46 (register-temp-stanza-handler-for-id
47 "1234a"
48 (lambda _ (throw 'error)))
49 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))))))
50 (test "handler remains if stanza with non-matching id is received" e
51 (assert-equal 1
52 (begin
53 (register-temp-stanza-handler-for-id
54 "1234b"
55 (lambda _ (throw 'error)))
56 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
57 (hash-count (const #t)
58 (@@ (gnubba xmpp) *stanza-id-handlers*)))))
59 (test "handler is removed after execution" e
60 (assert-equal 0
61 (begin
62 (register-temp-stanza-handler-for-id
63 "999"
64 (lambda _ 'handler))
65 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
66 (hash-count (const #t)
67 (@@ (gnubba xmpp) *stanza-id-handlers*))))))
68 (options)
69 (setups
70 (setup 'stanza (iq "payload" #:to "romeo@capulet.it" #:id "999")))
71 (teardowns
72 ;; always reset the internal state after each test
73 (teardown e (set! (@@ (gnubba xmpp) *stanza-id-handlers*)
74 (make-hash-table)))))
75
76 (suite "register-stanza-handler"
77 (tests
78 (test "initially, *stanza-handlers* should be empty" e
79 (assert-equal '() ((e 'handlers))))
80 (test "after registering a handler *stanza-handlers* contains one handler" e
81 (assert-equal 1
82 (begin
83 (register-stanza-handler (lambda _ 'handler1))
84 (length ((e 'handlers))))))
85 (test "after registering two handlers *stanza-handlers* contains two handlers" e
86 (assert-equal 2
87 (begin
88 (register-stanza-handler (lambda _ 'handler1))
89 (register-stanza-handler (lambda _ 'handler2))
90 (length ((e 'handlers))))))
91 (test "handlers may have guards" e
92 (assert-equal 3
93 (begin
94 (register-stanza-handler message?
95 (lambda _ 'handler1))
96 (register-stanza-handler iq?
97 (lambda _ 'handler2))
98 (register-stanza-handler #t
99 (lambda _ 'handler2))
100 (length ((e 'handlers)))))))
101 (options)
102 (setups
103 (setup 'handlers (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
104 (teardowns
105 ;; always reset the internal state after each test
106 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
107
108 (suite "try-stanza-handlers"
109 (tests
110 (test "a handler registered without a guard or #t is executed for any stanza" e
111 (assert-equal '(handler2 handler1)
112 (begin
113 (register-stanza-handler
114 (lambda _ 'handler1))
115 (register-stanza-handler
116 #t
117 (lambda _ 'handler2))
118 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
119 (test "handlers with guards are only executed for stanzas that match (a)" e
120 (assert-equal '(#f handler1)
121 (begin
122 (register-stanza-handler message?
123 (lambda _ 'handler1))
124 (register-stanza-handler iq?
125 (lambda _ 'handler2))
126 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
127 (test "handlers with guards are only executed for stanzas that match (b)" e
128 (assert-equal '(handler2 #f)
129 (begin
130 (register-stanza-handler message?
131 (lambda _ 'handler1))
132 (register-stanza-handler iq?
133 (lambda _ 'handler2))
134 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
135 (test "no handlers are executed if none of the guards match the stanza" e
136 (assert-equal '(#f #f)
137 (begin
138 (register-stanza-handler message?
139 (lambda _ 'handler1))
140 (register-stanza-handler iq?
141 (lambda _ 'handler2))
142 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
143 (test "when a handler throws 'halt no other handlers are executed" e
144 (assert-equal '(handler2 handler3)
145 (let ((*executed* '()))
146 (register-stanza-handler
147 (lambda _ (set! *executed* (cons 'handler1 *executed*))))
148 (register-stanza-handler
149 (lambda _
150 (set! *executed* (cons 'handler2 *executed*))
151 (throw 'halt 'handler2)))
152 (register-stanza-handler
153 (lambda _ (set! *executed* (cons 'handler3 *executed*))))
154 (catch 'halt
155 (lambda _
156 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
157 (lambda _ #t))
158 *executed*))))
159 (options)
160 (setups
161 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
162 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
163 (setup 'presence1 (presence #:id "1234")))
164 (teardowns
165 ;; always reset the internal state after each test
166 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
167
168 ;; TODO
169 (suite "next-stanza-id!" (tests))
170 (suite "handle-stanza"
171 (tests
172 (test "calls id handler first, then generic handler" e
173 (assert-equal
174 '(generic-handler id-handler)
175 (let ((results '()))
176 (register-stanza-handler
177 (lambda _ (set! results (cons 'generic-handler results))))
178 (register-temp-stanza-handler-for-id
179 (stanza-id (e 'stanza))
180 (lambda _ (set! results (cons 'id-handler results))))
181 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
182 results)))
183 (test "catches 'halt" e
184 (assert-false
185 (error?
186 (begin
187 (register-stanza-handler
188 (lambda _ (throw 'never-executed)))
189 (register-temp-stanza-handler-for-id
190 (stanza-id (e 'stanza))
191 (lambda _ (throw 'halt)))
192 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza)))))))
193 (options)
194 (setups
195 (setup 'stanza (iq "payload" #:to "romeo@capulet.it" #:id "1234")))
196 (teardowns
197 ;; always reset the internal state after each test
198 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
199
200 (suite "run-handler-loop"
201 (tests
202 (test "does not die when a handler throws an exception" e
203 (assert-false
204 (error? (begin
205 (register-stanza-handler
206 (lambda _ (throw 'some-error "no reason")))
207 (call-with-input-string
208 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
209 run-handler-loop)))))
210 (test "processes all stanzas in the queue" e
211 (assert-equal 2
212 (let ((count 0))
213 (register-stanza-handler
214 (lambda _ (begin (set! count (1+ count))
215 (throw 'some-error "no reason"))))
216 (call-with-input-string
217 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
218 run-handler-loop)
219 count)))))