write tests for handle-stanza
[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 ;; TODO
42 (suite "register-temp-stanza-handler-for-id" (tests))
43
44 (suite "register-stanza-handler"
45 (tests
46 (test "initially, *stanza-handlers* should be empty" e
47 (assert-equal '() ((e 'handlers))))
48 (test "after registering a handler *stanza-handlers* contains one handler" e
49 (assert-equal 1
50 (begin
51 (register-stanza-handler (lambda _ 'handler1))
52 (length ((e 'handlers))))))
53 (test "after registering two handlers *stanza-handlers* contains two handlers" e
54 (assert-equal 2
55 (begin
56 (register-stanza-handler (lambda _ 'handler1))
57 (register-stanza-handler (lambda _ 'handler2))
58 (length ((e 'handlers))))))
59 (test "handlers may have guards" e
60 (assert-equal 3
61 (begin
62 (register-stanza-handler message?
63 (lambda _ 'handler1))
64 (register-stanza-handler iq?
65 (lambda _ 'handler2))
66 (register-stanza-handler #t
67 (lambda _ 'handler2))
68 (length ((e 'handlers)))))))
69 (options)
70 (setups
71 (setup 'handlers (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
72 (teardowns
73 ;; always reset the internal state after each test
74 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
75
76 (suite "try-stanza-handlers"
77 (tests
78 (test "a handler registered without a guard or #t is executed for any stanza" e
79 (assert-equal '(handler2 handler1)
80 (begin
81 (register-stanza-handler
82 (lambda _ 'handler1))
83 (register-stanza-handler
84 #t
85 (lambda _ 'handler2))
86 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
87 (test "handlers with guards are only executed for stanzas that match (a)" e
88 (assert-equal '(#f handler1)
89 (begin
90 (register-stanza-handler message?
91 (lambda _ 'handler1))
92 (register-stanza-handler iq?
93 (lambda _ 'handler2))
94 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
95 (test "handlers with guards are only executed for stanzas that match (b)" e
96 (assert-equal '(handler2 #f)
97 (begin
98 (register-stanza-handler message?
99 (lambda _ 'handler1))
100 (register-stanza-handler iq?
101 (lambda _ 'handler2))
102 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
103 (test "no handlers are executed if none of the guards match the stanza" e
104 (assert-equal '(#f #f)
105 (begin
106 (register-stanza-handler message?
107 (lambda _ 'handler1))
108 (register-stanza-handler iq?
109 (lambda _ 'handler2))
110 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
111 (test "when a handler throws 'halt no other handlers are executed" e
112 (assert-equal '(handler2 handler3)
113 (let ((*executed* '()))
114 (register-stanza-handler
115 (lambda _ (set! *executed* (cons 'handler1 *executed*))))
116 (register-stanza-handler
117 (lambda _
118 (set! *executed* (cons 'handler2 *executed*))
119 (throw 'halt 'handler2)))
120 (register-stanza-handler
121 (lambda _ (set! *executed* (cons 'handler3 *executed*))))
122 (catch 'halt
123 (lambda _
124 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
125 (lambda _ #t))
126 *executed*))))
127 (options)
128 (setups
129 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
130 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
131 (setup 'presence1 (presence #:id "1234")))
132 (teardowns
133 ;; always reset the internal state after each test
134 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
135
136 ;; TODO
137 (suite "next-stanza-id!" (tests))
138 (suite "handle-stanza"
139 (tests
140 (test "calls id handler first, then generic handler" e
141 (assert-equal
142 '(generic-handler id-handler)
143 (let ((results '()))
144 (register-stanza-handler
145 (lambda _ (set! results (cons 'generic-handler results))))
146 (register-temp-stanza-handler-for-id
147 (stanza-id (e 'stanza))
148 (lambda _ (set! results (cons 'id-handler results))))
149 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
150 results)))
151 (test "catches 'halt" e
152 (assert-false
153 (error?
154 (begin
155 (register-stanza-handler
156 (lambda _ (throw 'never-executed)))
157 (register-temp-stanza-handler-for-id
158 (stanza-id (e 'stanza))
159 (lambda _ (throw 'halt)))
160 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza)))))))
161 (options)
162 (setups
163 (setup 'stanza (iq "payload" #:to "romeo@capulet.it" #:id "1234")))
164 (teardowns
165 ;; always reset the internal state after each test
166 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
167
168 (suite "run-handler-loop"
169 (tests
170 (test "does not die when a handler throws an exception" e
171 (assert-false
172 (error? (begin
173 (register-stanza-handler
174 (lambda _ (throw 'some-error "no reason")))
175 (call-with-input-string
176 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
177 run-handler-loop)))))
178 (test "processes all stanzas in the queue" e
179 (assert-equal 2
180 (let ((count 0))
181 (register-stanza-handler
182 (lambda _ (begin (set! count (1+ count))
183 (throw 'some-error "no reason"))))
184 (call-with-input-string
185 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
186 run-handler-loop)
187 count)))))