AtlatestRepositorysigil-irc

sigil-irc / tree / testtest-capability.sgl

1;;; Tests for IRCv3 capability descriptors and cap negotiation
2;;; state machines (both client and server perspectives).
3
4(import (sigil test)
5 (sigil string)
6 (sigil irc message)
7 (sigil irc capability)
8 (sigil irc cap-negotiation))
9
10(test-group "Capability descriptors"
12 (test "string->cap parses name only"
13 (let ((c (string->cap "sasl")))
14 (assert-equal "sasl" (cap-name c))
15 (assert-equal #f (cap-value c))))
17 (test "string->cap parses name=value"
18 (let ((c (string->cap "sasl=PLAIN,EXTERNAL")))
19 (assert-equal "sasl" (cap-name c))
20 (assert-equal "PLAIN,EXTERNAL" (cap-value c))))
22 (test "cap->string round-trips"
23 (assert-equal "sasl=PLAIN" (cap->string (string->cap "sasl=PLAIN")))
24 (assert-equal "echo-message" (cap->string (string->cap "echo-message"))))
26 (test "parse-cap-list splits and parses"
27 (let ((caps (parse-cap-list "sasl=PLAIN message-tags server-time")))
28 (assert-equal 3 (length caps))
29 (assert-equal "sasl" (cap-name (car caps)))
30 (assert-equal "PLAIN" (cap-value (car caps)))
31 (assert-equal "message-tags" (cap-name (cadr caps)))
32 (assert-equal #f (cap-value (cadr caps)))))
34 (test "tier-1-caps includes core IRCv3 caps"
35 (let ((t1 (tier-1-caps)))
36 (assert-true (member CAP-SASL t1))
37 (assert-true (member CAP-MESSAGE-TAGS t1))
38 (assert-true (member CAP-SERVER-TIME t1))
39 (assert-true (member CAP-BATCH t1))
40 (assert-true (member CAP-LABELED-RESPONSE t1))
41 (assert-true (member CAP-ECHO-MESSAGE t1))
42 (assert-true (member CAP-EXTENDED-JOIN t1))
43 (assert-true (member CAP-AWAY-NOTIFY t1))))
45 (test "tier-2-caps includes mobile-critical drafts"
46 (let ((t2 (tier-2-caps)))
47 (assert-true (member CAP-CHATHISTORY t2))
48 (assert-true (member CAP-READ-MARKER t2)))))
51(test-group "CAP client state machine"
53 (test "start emits CAP LS 302"
54 (let ((s (make-cap-client-state desired: '("sasl"))))
55 (assert-equal "CAP LS 302\r\n" (cap-client-start s))
56 (assert-equal 'ls (cap-client-state-phase s))))
58 (test "single-line LS triggers REQ for desired-and-available caps"
59 (let ((s (make-cap-client-state desired: '("sasl" "message-tags" "missing"))))
60 (cap-client-start s)
61 (let* ((ls-msg (parse-irc-message
62 ":server CAP * LS :sasl=PLAIN message-tags server-time"))
63 (out (cap-client-advance s ls-msg)))
64 (assert-equal 'req (cap-client-state-phase s))
65 (assert-equal 1 (length out))
66 ;; Should have requested both desired-and-supported caps
67 (assert-true (or (string=? (car out) "CAP REQ :sasl message-tags\r\n")
68 (string=? (car out) "CAP REQ :message-tags sasl\r\n"))))))
70 (test "multi-line LS waits for terminator before REQ"
71 (let ((s (make-cap-client-state desired: '("sasl" "server-time"))))
72 (cap-client-start s)
73 (let* ((m1 (parse-irc-message ":server CAP * LS * :sasl=PLAIN"))
74 (out1 (cap-client-advance s m1)))
75 ;; Continuation line: no REQ yet.
76 (assert-equal '() out1)
77 (assert-equal 'ls (cap-client-state-phase s))
78 (let* ((m2 (parse-irc-message ":server CAP * LS :server-time"))
79 (out2 (cap-client-advance s m2)))
80 (assert-equal 'req (cap-client-state-phase s))
81 (assert-equal 1 (length out2))))))
83 (test "ACK transitions to done and emits CAP END"
84 (let ((s (make-cap-client-state desired: '("sasl"))))
85 (cap-client-start s)
86 (cap-client-advance s (parse-irc-message ":s CAP * LS :sasl"))
87 (let ((out (cap-client-advance s (parse-irc-message ":s CAP * ACK :sasl"))))
88 (assert-equal 'done (cap-client-state-phase s))
89 (assert-equal 1 (length out))
90 (assert-equal "CAP END\r\n" (car out))
91 (assert-true (member "sasl" (cap-client-state-acked s))))))
93 (test "NAK records nakked caps and ends"
94 (let ((s (make-cap-client-state desired: '("sasl" "message-tags"))))
95 (cap-client-start s)
96 (cap-client-advance s (parse-irc-message ":s CAP * LS :sasl message-tags"))
97 (cap-client-advance s (parse-irc-message ":s CAP * NAK :sasl"))
98 (assert-equal 'done (cap-client-state-phase s))
99 (assert-true (member "sasl" (cap-client-state-nakked s)))))
101 (test "no overlap means immediate CAP END (no REQ)"
102 (let ((s (make-cap-client-state desired: '("nonexistent"))))
103 (cap-client-start s)
104 (let ((out (cap-client-advance s (parse-irc-message ":s CAP * LS :sasl"))))
105 (assert-equal 'done (cap-client-state-phase s))
106 (assert-equal 1 (length out))
107 (assert-equal "CAP END\r\n" (car out))))))
110(test-group "CAP server state machine"
112 (define (make-server)
113 (make-cap-server-state
114 server-name: "enclave.example"
115 supported: (list (make-cap "sasl" value: "PLAIN,EXTERNAL")
116 (make-cap "message-tags")
117 (make-cap "server-time")
118 (make-cap "batch")
119 (make-cap "echo-message"))))
121 (test "answers CAP LS 302 with supported list"
122 (let* ((s (make-server))
123 (out (cap-server-advance s (parse-irc-message "CAP LS 302")
124 client-nick: "*")))
125 (assert-equal 1 (length out))
126 (assert-equal 'ls-sent (cap-server-state-phase s))
127 (assert-true (cap-server-state-cap-302 s))
128 ;; Reply must be ":<server> CAP * LS :<caps>\r\n"
129 (let ((line (car out)))
130 (assert-true (or (string-contains? line "sasl=PLAIN,EXTERNAL")
131 (string-contains? line "sasl"))))))
133 (test "ACKs valid CAP REQ and updates enabled set"
134 (let ((s (make-server)))
135 (cap-server-advance s (parse-irc-message "CAP LS 302"))
136 (let ((out (cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))))
137 (assert-equal 1 (length out))
138 (assert-true (string-contains? (car out) "ACK"))
139 (assert-true (member "sasl" (cap-server-state-enabled s)))
140 (assert-true (member "message-tags" (cap-server-state-enabled s))))))
142 (test "NAKs unknown CAP REQ atomically"
143 (let ((s (make-server)))
144 (cap-server-advance s (parse-irc-message "CAP LS 302"))
145 (let ((out (cap-server-advance s (parse-irc-message "CAP REQ :sasl bogus-cap"))))
146 (assert-equal 1 (length out))
147 (assert-true (string-contains? (car out) "NAK"))
148 ;; Atomic — neither cap should be enabled.
149 (assert-false (member "sasl" (cap-server-state-enabled s))))))
151 (test "CAP REQ with -name disables previously-enabled cap"
152 (let ((s (make-server)))
153 (cap-server-advance s (parse-irc-message "CAP LS 302"))
154 (cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))
155 (cap-server-advance s (parse-irc-message "CAP REQ :-sasl"))
156 (assert-false (member "sasl" (cap-server-state-enabled s)))
157 (assert-true (member "message-tags" (cap-server-state-enabled s)))))
159 (test "CAP END transitions to done"
160 (let ((s (make-server)))
161 (cap-server-advance s (parse-irc-message "CAP LS 302"))
162 (cap-server-advance s (parse-irc-message "CAP REQ :sasl"))
163 (cap-server-advance s (parse-irc-message "CAP END"))
164 (assert-equal 'done (cap-server-state-phase s))))
166 (test "CAP LIST returns currently-enabled caps"
167 (let ((s (make-server)))
168 (cap-server-advance s (parse-irc-message "CAP LS 302"))
169 (cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))
170 (let ((out (cap-server-advance s (parse-irc-message "CAP LIST"))))
171 (assert-equal 1 (length out))
172 (assert-true (string-contains? (car out) "LIST"))
173 (assert-true (string-contains? (car out) "sasl"))))))
175(run-tests)