Commit088f2ba2Recorded27 Apr 2026Repositorysigil-irc
Add capability descriptors and CAP negotiation state machines
Message
(sigil irc capability) — descriptor record + parser: cap, make-cap, cap-name, cap-value cap->string, string->cap, parse-cap-list CAP-SASL, CAP-MESSAGE-TAGS, CAP-SERVER-TIME, CAP-ACCOUNT-TAG, CAP-ACCOUNT-NOTIFY, CAP-EXTENDED-JOIN, CAP-USERHOST-IN-NAMES, CAP-MULTI-PREFIX, CAP-AWAY-NOTIFY, CAP-CHGHOST, CAP-INVITE-NOTIFY, CAP-SETNAME, CAP-BATCH, CAP-LABELED-RESPONSE, CAP-ECHO-MESSAGE, CAP-CAP-NOTIFY CAP-CHATHISTORY, CAP-READ-MARKER, CAP-MONITOR tier-1-caps, tier-2-caps, standard-caps
(sigil irc cap-negotiation) — pure-value state machines for both sides of the CAP negotiation handshake. The consumer feeds each incoming irc-message through cap-{client,server}-advance and gets back a list of wire-format strings to send.
Client side handles: CAP LS 302 multi-line continuation, intersection-with-desired auto-REQ, ACK / NAK / NEW / DEL handling, automatic CAP END.
Server side handles: LS / LIST / REQ / END subcommands, atomic REQ enable/disable (any unknown cap NAKs the whole request), optional value-spec on advertised caps (e.g. sasl=PLAIN,EXTERNAL), v3.2 detection.
Both expose their state as inspectable fields so the consumer can make decisions (skip SASL if not ACKed, etc.).
Changed
src/sigil/irc/cap-negotiation.sgl | 360 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/irc/capability.sgl | 200 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-capability.sgl | 174 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 734 insertions(+)Diff
src/sigil/irc/cap-negotiation.sgladded
@@ -0,0 +1,360 @@
+1
;;; (sigil irc cap-negotiation) - CAP negotiation state machines+2
;;;+3
;;; CAP negotiation is the IRCv3 handshake by which client and server+4
;;; agree on a set of optional capabilities. The wire dance:+5
;;;+6
;;; C: CAP LS 302+7
;;; S: CAP * LS * :sasl=PLAIN,EXTERNAL message-tags ...+8
;;; S: CAP * LS :server-time chghost ...+9
;;; C: CAP REQ :sasl message-tags server-time+10
;;; S: CAP * ACK :sasl message-tags server-time (or NAK)+11
;;; C: AUTHENTICATE PLAIN (if SASL was negotiated)+12
;;; ...+13
;;; C: CAP END+14
;;;+15
;;; This module provides two state machines, one per role. Both follow+16
;;; the same shape: a state value + an `advance` function that takes+17
;;; an incoming `irc-message` and returns `(values new-state outbound)`+18
;;; where `outbound` is a list of wire-format strings to send.+19
;;;+20
;;; The state machine is a pure value — the consumer owns I/O and fiber+21
;;; structure. This matches the protocol-only contract of sigil-irc.+22
+23
(define-library (sigil irc cap-negotiation)+24
(import (sigil core)+25
(sigil string)+26
(sigil struct)+27
(sigil irc message)+28
(sigil irc capability))+29
+30
(export+31
;; Client side+32
cap-client-state+33
cap-client-state?+34
make-cap-client-state+35
cap-client-state-phase+36
cap-client-state-server-caps+37
cap-client-state-requested+38
cap-client-state-acked+39
cap-client-state-nakked+40
cap-client-state-done?+41
cap-client-start+42
cap-client-advance+43
+44
;; Server side+45
cap-server-state+46
cap-server-state?+47
make-cap-server-state+48
cap-server-state-phase+49
cap-server-state-supported+50
cap-server-state-enabled+51
cap-server-state-cap-302+52
cap-server-state-done?+53
cap-server-advance)+54
+55
(begin+56
+57
;; ============================================================+58
;; Client-side state machine+59
;; ============================================================+60
;;+61
;; Phases:+62
;; 'init - haven't sent CAP LS yet (call cap-client-start)+63
;; 'ls - waiting for CAP LS responses (may span multiple lines)+64
;; 'req - sent CAP REQ, waiting for ACK or NAK+65
;; 'done - CAP END sent, negotiation complete+66
;;+67
;; The client supplies `desired` — caps it would like — and a+68
;; `select` callback that, given the server-advertised caps, returns+69
;; the subset to actually request. Default selector picks the+70
;; intersection of `desired` and `available`.+71
+72
(define-struct cap-client-state+73
(phase default: 'init mutable: #t) ; 'init | 'ls | 'req | 'done+74
(desired default: '()) ; list of cap names (strings)+75
(server-caps default: '() mutable: #t) ; alist of cap name -> value-or-#f+76
(requested default: '() mutable: #t) ; caps in current REQ+77
(acked default: '() mutable: #t) ; caps server ACKed+78
(nakked default: '() mutable: #t)) ; caps server NAKed+79
+80
;;; Build a client-side CAP state with a list of desired capability+81
;;; names. After construction, call `cap-client-start` to get the+82
;;; opening CAP LS line, then feed each incoming CAP / numeric reply+83
;;; through `cap-client-advance`.+84
(define (make-cap-client-state (keys: (desired '())))+85
(: (desired: list?) -> cap-client-state?)+86
(cap-client-state phase: 'init desired: desired))+87
+88
(define (cap-client-state-done? s)+89
(: cap-client-state? -> boolean?)+90
(eq? (cap-client-state-phase s) 'done))+91
+92
;;; Begin negotiation. Returns the line to send (`CAP LS 302\r\n`).+93
;;; Transitions phase to `'ls`.+94
(define (cap-client-start state)+95
(: cap-client-state? -> string?)+96
(set-cap-client-state-phase! state 'ls)+97
"CAP LS 302\r\n")+98
+99
;;; Process one incoming message and advance the state. Returns a+100
;;; list of wire-format strings to send (possibly empty). Messages+101
;;; that aren't CAP-related are simply ignored.+102
(define (cap-client-advance state msg)+103
(: cap-client-state? irc-message? -> list?)+104
(let ((cmd (irc-message-command msg)))+105
(cond+106
((eq? cmd 'CAP) (handle-client-cap state msg))+107
(else '()))))+108
+109
(define (handle-client-cap state msg)+110
(let* ((params (irc-message-params msg))+111
;; CAP messages: <client> <subcmd> [...args...]+112
(subcmd (and (>= (length params) 2) (cadr params)))+113
(rest (if (and (>= (length params) 2)) (cddr params) '())))+114
(cond+115
((equal? subcmd "LS") (handle-client-cap-ls state msg rest))+116
((equal? subcmd "ACK") (handle-client-cap-ack state msg))+117
((equal? subcmd "NAK") (handle-client-cap-nak state msg))+118
((equal? subcmd "NEW") (handle-client-cap-new state msg))+119
((equal? subcmd "DEL") (handle-client-cap-del state msg))+120
(else '()))))+121
+122
;; CAP LS may be split across multiple lines: the third param is `*`+123
;; for "more to come" or absent on the last line. Capability list is+124
;; in trailing.+125
(define (handle-client-cap-ls state msg rest)+126
(let* ((multi? (and (pair? rest) (equal? (car rest) "*")))+127
(caps-text (or (irc-message-trailing msg) ""))+128
(caps (parse-cap-list caps-text)))+129
;; Accumulate caps+130
(set-cap-client-state-server-caps!+131
state+132
(append+133
(cap-client-state-server-caps state)+134
(map (lambda (c) (cons (cap-name c) (cap-value c))) caps)))+135
(if multi?+136
;; Wait for more LS lines.+137
'()+138
;; Final LS line: pick caps and send REQ.+139
(issue-client-req state))))+140
+141
(define (issue-client-req state)+142
(let* ((server-caps (cap-client-state-server-caps state))+143
(desired (cap-client-state-desired state))+144
(intersect (filter (lambda (name)+145
(any (lambda (entry)+146
(equal? (car entry) name))+147
server-caps))+148
desired)))+149
(cond+150
((null? intersect)+151
;; Nothing to negotiate — send CAP END immediately.+152
(set-cap-client-state-phase! state 'done)+153
(list "CAP END\r\n"))+154
(else+155
(set-cap-client-state-requested! state intersect)+156
(set-cap-client-state-phase! state 'req)+157
(list (string-append "CAP REQ :"+158
(string-join intersect " ")+159
"\r\n"))))))+160
+161
(define (handle-client-cap-ack state msg)+162
(let* ((acked-text (or (irc-message-trailing msg) ""))+163
(acked (map cap-name (parse-cap-list acked-text))))+164
(set-cap-client-state-acked!+165
state+166
(append (cap-client-state-acked state) acked))+167
;; Per spec, ACK may include caps prefixed with `-` (disable). We+168
;; treat them as acked here — the consumer can inspect the raw+169
;; trailing if it cares about disable directives.+170
;;+171
;; If SASL is among the ACKed caps the consumer wants to drive+172
;; SASL before sending CAP END. Indicate completion of the CAP+173
;; round but don't send CAP END automatically — the consumer+174
;; calls `cap-client-end` at the right moment.+175
(set-cap-client-state-phase! state 'done)+176
(list "CAP END\r\n")))+177
+178
(define (handle-client-cap-nak state msg)+179
(let* ((nakked-text (or (irc-message-trailing msg) ""))+180
(nakked (map cap-name (parse-cap-list nakked-text))))+181
(set-cap-client-state-nakked!+182
state+183
(append (cap-client-state-nakked state) nakked))+184
;; Even on NAK we end negotiation; consumer can decide whether to+185
;; abort the connection based on `cap-client-state-nakked`.+186
(set-cap-client-state-phase! state 'done)+187
(list "CAP END\r\n")))+188
+189
;; CAP NEW announces caps the server has gained mid-session. We+190
;; record them in `server-caps` for the consumer's awareness; we do+191
;; NOT auto-request, since post-handshake REQ requires the consumer's+192
;; intent.+193
(define (handle-client-cap-new state msg)+194
(let* ((caps-text (or (irc-message-trailing msg) ""))+195
(caps (parse-cap-list caps-text)))+196
(set-cap-client-state-server-caps!+197
state+198
(append+199
(cap-client-state-server-caps state)+200
(map (lambda (c) (cons (cap-name c) (cap-value c))) caps)))+201
'()))+202
+203
;; CAP DEL removes caps mid-session.+204
(define (handle-client-cap-del state msg)+205
(let* ((caps-text (or (irc-message-trailing msg) ""))+206
(names (map cap-name (parse-cap-list caps-text))))+207
(set-cap-client-state-server-caps!+208
state+209
(filter (lambda (entry)+210
(not (member (car entry) names)))+211
(cap-client-state-server-caps state)))+212
'()))+213
+214
+215
;; ============================================================+216
;; Server-side state machine+217
;; ============================================================+218
;;+219
;; Phases:+220
;; 'init - awaiting first CAP LS / REQ / END from the client+221
;; 'ls-sent - we've answered LS; waiting for REQ or END+222
;; 'done - client sent CAP END; registration may proceed+223
;;+224
;; The server constructs the state with its full supported-cap list+225
;; (each as a `cap` record so SASL etc. can advertise mechanism+226
;; lists). It also passes a server-name used in CAP reply prefixes+227
;; (e.g. `enclave.example`).+228
+229
(define-struct cap-server-state+230
(phase default: 'init mutable: #t)+231
(server-name default: "*") ; used in CAP reply prefix+232
(supported default: '()) ; list of cap records+233
(enabled default: '() mutable: #t) ; list of enabled cap-name strings+234
(cap-302 default: #t mutable: #t)) ; whether client speaks 302+235
+236
;;; Construct a server-side CAP state. `supported` is a list of `cap`+237
;;; records. `server-name` appears in reply prefixes (typically the+238
;;; server's domain).+239
(define (make-cap-server-state (keys: (server-name "*")+240
(supported '())))+241
(: (server-name: string?) (supported: list?) -> cap-server-state?)+242
(cap-server-state server-name: server-name supported: supported))+243
+244
(define (cap-server-state-done? s)+245
(: cap-server-state? -> boolean?)+246
(eq? (cap-server-state-phase s) 'done))+247
+248
(define (cap-reply-prefix state nick)+249
(string-append ":" (cap-server-state-server-name state)+250
" CAP "+251
(or nick "*")+252
" "))+253
+254
;;; Process one incoming CAP message from the client and advance the+255
;;; state. Returns a list of wire-format strings to send back.+256
;;; Non-CAP messages are ignored. The client's current nick (or `#f`+257
;;; if not yet known, in which case `*` is used in replies) is+258
;;; passed in so the reply prefix matches the spec.+259
(define (cap-server-advance state msg (keys: (client-nick #f)))+260
(: cap-server-state? irc-message? (client-nick: any?) -> list?)+261
(let ((cmd (irc-message-command msg)))+262
(cond+263
((eq? cmd 'CAP) (handle-server-cap state msg client-nick))+264
(else '()))))+265
+266
(define (handle-server-cap state msg client-nick)+267
(let* ((params (irc-message-params msg))+268
;; Client → Server CAP messages are: CAP <subcmd> [args...]+269
;; (the prefix isn't required; the subcmd is the first param).+270
(subcmd (and (pair? params) (car params))))+271
(cond+272
((equal? subcmd "LS") (handle-server-cap-ls state msg client-nick params))+273
((equal? subcmd "LIST") (handle-server-cap-list state client-nick))+274
((equal? subcmd "REQ") (handle-server-cap-req state msg client-nick))+275
((equal? subcmd "END") (handle-server-cap-end state))+276
(else '()))))+277
+278
(define (handle-server-cap-ls state msg client-nick params)+279
;; The presence of a `302` argument means the client speaks v3.2+280
;; (CAP-NOTIFY support, value-spec aware, sticky negotiation, ...).+281
(let* ((version-arg (and (>= (length params) 2) (cadr params)))+282
(v3.2? (equal? version-arg "302")))+283
(set-cap-server-state-cap-302! state v3.2?))+284
(set-cap-server-state-phase! state 'ls-sent)+285
(let* ((supported (cap-server-state-supported state))+286
(cap-strings (map cap->string supported))+287
;; Single-line LS for now — simple, safe under typical+288
;; payload sizes (well under the 8K default).+289
(body (string-join cap-strings " ")))+290
(list (string-append (cap-reply-prefix state client-nick)+291
"LS :"+292
body+293
"\r\n"))))+294
+295
(define (handle-server-cap-list state client-nick)+296
(let ((body (string-join (cap-server-state-enabled state) " ")))+297
(list (string-append (cap-reply-prefix state client-nick)+298
"LIST :"+299
body+300
"\r\n"))))+301
+302
(define (handle-server-cap-req state msg client-nick)+303
;; REQ argument is in trailing (preferred) or last param.+304
(let* ((req-text (or (irc-message-trailing msg)+305
(let ((p (irc-message-params msg)))+306
(if (>= (length p) 2)+307
(cadr p)+308
""))))+309
(requests (string-split req-text " "))+310
;; Each request can be `name` (enable) or `-name` (disable).+311
(supported-names (map cap-name (cap-server-state-supported state))))+312
(let-values (((normalized all-known?)+313
(let loop ((reqs requests) (norm '()) (ok? #t))+314
(cond+315
((null? reqs) (values (reverse norm) ok?))+316
(else+317
(let* ((r (car reqs))+318
(disable? (and (> (string-length r) 0)+319
(char=? (string-ref r 0) #\-)))+320
(name (if disable?+321
(substring r 1 (string-length r))+322
r)))+323
(if (member name supported-names)+324
(loop (cdr reqs)+325
(cons (cons name disable?) norm)+326
ok?)+327
(loop (cdr reqs) norm #f))))))))+328
(cond+329
((not all-known?)+330
;; Atomic: any unknown cap means NAK the whole REQ. Don't+331
;; mutate enabled.+332
(list (string-append (cap-reply-prefix state client-nick)+333
"NAK :"+334
req-text+335
"\r\n")))+336
(else+337
;; Apply enable/disable atomically.+338
(let ((enabled (cap-server-state-enabled state)))+339
(let loop ((entries normalized) (e enabled))+340
(cond+341
((null? entries)+342
(set-cap-server-state-enabled! state e))+343
(else+344
(let ((name (caar entries))+345
(disable? (cdar entries)))+346
(loop (cdr entries)+347
(cond+348
(disable? (filter (lambda (x) (not (equal? x name))) e))+349
((member name e) e)+350
(else (cons name e))))))))+351
(list (string-append (cap-reply-prefix state client-nick)+352
"ACK :"+353
req-text+354
"\r\n"))))))))+355
+356
(define (handle-server-cap-end state)+357
(set-cap-server-state-phase! state 'done)+358
'())+359
+360
))src/sigil/irc/capability.sgladded
@@ -0,0 +1,200 @@
+1
;;; (sigil irc capability) - IRCv3 capability descriptors+2
;;;+3
;;; Capability negotiation in IRCv3 lets clients and servers agree on+4
;;; which optional features both sides support. Each capability is named+5
;;; (e.g. `sasl`, `server-time`, `chathistory`) and may carry a value+6
;;; specification (e.g. `sasl=PLAIN,EXTERNAL,SCRAM-SHA-256`).+7
;;;+8
;;; This module provides:+9
;;;+10
;;; - Constant names for every Tier 1 + Tier 2 capability sigil-irc+11
;;; knows about+12
;;; - A `cap` record for representing a capability with optional value+13
;;; - Parsers for `CAP LS` / `CAP LIST` / `CAP REQ` argument bodies+14
;;;+15
;;; The state machines that drive negotiation live in+16
;;; `(sigil irc cap-negotiation)`.+17
+18
(define-library (sigil irc capability)+19
(import (sigil core)+20
(sigil string)+21
(sigil struct))+22
+23
(export+24
;; Cap descriptor+25
cap+26
cap?+27
make-cap+28
cap-name+29
cap-value+30
cap->string+31
string->cap+32
parse-cap-list+33
+34
;; Tier 1 capability names+35
CAP-SASL+36
CAP-MESSAGE-TAGS+37
CAP-SERVER-TIME+38
CAP-ACCOUNT-TAG+39
CAP-ACCOUNT-NOTIFY+40
CAP-EXTENDED-JOIN+41
CAP-USERHOST-IN-NAMES+42
CAP-MULTI-PREFIX+43
CAP-AWAY-NOTIFY+44
CAP-CHGHOST+45
CAP-INVITE-NOTIFY+46
CAP-SETNAME+47
CAP-BATCH+48
CAP-LABELED-RESPONSE+49
CAP-ECHO-MESSAGE+50
CAP-CAP-NOTIFY+51
+52
;; Tier 2 capability names+53
CAP-CHATHISTORY+54
CAP-READ-MARKER+55
CAP-MONITOR+56
+57
;; Helpers+58
tier-1-caps+59
tier-2-caps+60
standard-caps)+61
+62
(begin+63
+64
;; ============================================================+65
;; Capability record+66
;; ============================================================+67
+68
;;; A single capability with an optional value spec.+69
;;;+70
;;; The `name` is a string like `"sasl"` or `"draft/read-marker"`. The+71
;;; `value` is `#f` if no value is specified, otherwise a string+72
;;; (e.g. `"PLAIN,EXTERNAL"`). Values are parsed lazily by feature+73
;;; modules — for SASL, splitting on commas yields the mechanism list.+74
(define-struct cap+75
(name) ; string+76
(value default: #f)) ; string or #f+77
+78
;;; Construct a cap record.+79
(define (make-cap name (keys: (value #f)))+80
(: string? (value: any?) -> cap?)+81
(when (or (not (string? name)) (string=? name ""))+82
(error "make-cap: name must be a non-empty string"))+83
(cap name: name value: value))+84
+85
;;; Render a cap as `name` or `name=value`.+86
;;;+87
;;; ```scheme+88
;;; (cap->string (make-cap "sasl")) ; => "sasl"+89
;;; (cap->string (make-cap "sasl" value: "PLAIN,EXTERNAL"))+90
;;; ; => "sasl=PLAIN,EXTERNAL"+91
;;; ```+92
(define (cap->string c)+93
(: cap? -> string?)+94
(if (cap-value c)+95
(string-append (cap-name c) "=" (cap-value c))+96
(cap-name c)))+97
+98
;;; Parse a single capability spec (`name` or `name=value`) into a+99
;;; cap record.+100
;;;+101
;;; ```scheme+102
;;; (string->cap "sasl=PLAIN")+103
;;; ; => #<cap name: "sasl" value: "PLAIN">+104
;;; (string->cap "echo-message")+105
;;; ; => #<cap name: "echo-message" value: #f>+106
;;; ```+107
(define (string->cap str)+108
(: string? -> cap?)+109
(let ((eq-pos (string-index str (lambda (c) (char=? c #\=)))))+110
(if eq-pos+111
(cap name: (substring str 0 eq-pos)+112
value: (substring str (+ eq-pos 1) (string-length str)))+113
(cap name: str value: #f))))+114
+115
;;; Parse a CAP argument body — a space-separated list of capability+116
;;; specs — into a list of cap records.+117
;;;+118
;;; ```scheme+119
;;; (parse-cap-list "sasl=PLAIN message-tags server-time")+120
;;; ; => (#<cap "sasl"=PLAIN> #<cap "message-tags"> #<cap "server-time">)+121
;;; ```+122
(define (parse-cap-list str)+123
(: string? -> list?)+124
(if (string=? str "")+125
'()+126
(map string->cap (string-split str " "))))+127
+128
+129
;; ============================================================+130
;; Tier 1 capability names+131
;; ============================================================+132
+133
(define CAP-SASL "sasl")+134
(define CAP-MESSAGE-TAGS "message-tags")+135
(define CAP-SERVER-TIME "server-time")+136
(define CAP-ACCOUNT-TAG "account-tag")+137
(define CAP-ACCOUNT-NOTIFY "account-notify")+138
(define CAP-EXTENDED-JOIN "extended-join")+139
(define CAP-USERHOST-IN-NAMES "userhost-in-names")+140
(define CAP-MULTI-PREFIX "multi-prefix")+141
(define CAP-AWAY-NOTIFY "away-notify")+142
(define CAP-CHGHOST "chghost")+143
(define CAP-INVITE-NOTIFY "invite-notify")+144
(define CAP-SETNAME "setname")+145
(define CAP-BATCH "batch")+146
(define CAP-LABELED-RESPONSE "labeled-response")+147
(define CAP-ECHO-MESSAGE "echo-message")+148
(define CAP-CAP-NOTIFY "cap-notify")+149
+150
+151
;; ============================================================+152
;; Tier 2 capability names+153
;; ============================================================+154
+155
(define CAP-CHATHISTORY "draft/chathistory")+156
(define CAP-READ-MARKER "draft/read-marker")+157
;; MONITOR is a numeric-reply feature, not a CAP per se; senpai/inspircd+158
;; advertise its support via ISUPPORT (MONITOR=N). It is exposed here+159
;; for symmetry; the cap-negotiation module ignores it during CAP REQ.+160
(define CAP-MONITOR "monitor")+161
+162
+163
;; ============================================================+164
;; Bundled cap sets+165
;; ============================================================+166
+167
;;; The Tier 1 ratified IRCv3 capabilities (the must-have set).+168
(define (tier-1-caps)+169
(: -> list?)+170
(list CAP-SASL+171
CAP-MESSAGE-TAGS+172
CAP-SERVER-TIME+173
CAP-ACCOUNT-TAG+174
CAP-ACCOUNT-NOTIFY+175
CAP-EXTENDED-JOIN+176
CAP-USERHOST-IN-NAMES+177
CAP-MULTI-PREFIX+178
CAP-AWAY-NOTIFY+179
CAP-CHGHOST+180
CAP-INVITE-NOTIFY+181
CAP-SETNAME+182
CAP-BATCH+183
CAP-LABELED-RESPONSE+184
CAP-ECHO-MESSAGE+185
CAP-CAP-NOTIFY))+186
+187
;;; The Tier 2 high-value drafts/extensions sigil-irc supports.+188
(define (tier-2-caps)+189
(: -> list?)+190
(list CAP-CHATHISTORY+191
CAP-READ-MARKER))+192
+193
;;; The full set of caps sigil-irc knows about. Servers built on+194
;;; sigil-irc can advertise a subset by filtering this list against+195
;;; what the server actually implements.+196
(define (standard-caps)+197
(: -> list?)+198
(append (tier-1-caps) (tier-2-caps)))+199
+200
))test/test-capability.sgladded
@@ -0,0 +1,174 @@
+1
;;; Tests for IRCv3 capability descriptors and cap negotiation+2
;;; state machines (both client and server perspectives).+3
+4
(import (sigil test)+5
(sigil irc message)+6
(sigil irc capability)+7
(sigil irc cap-negotiation))+8
+9
(test-group "Capability descriptors"+10
+11
(test "string->cap parses name only"+12
(let ((c (string->cap "sasl")))+13
(assert-equal "sasl" (cap-name c))+14
(assert-equal #f (cap-value c))))+15
+16
(test "string->cap parses name=value"+17
(let ((c (string->cap "sasl=PLAIN,EXTERNAL")))+18
(assert-equal "sasl" (cap-name c))+19
(assert-equal "PLAIN,EXTERNAL" (cap-value c))))+20
+21
(test "cap->string round-trips"+22
(assert-equal "sasl=PLAIN" (cap->string (string->cap "sasl=PLAIN")))+23
(assert-equal "echo-message" (cap->string (string->cap "echo-message"))))+24
+25
(test "parse-cap-list splits and parses"+26
(let ((caps (parse-cap-list "sasl=PLAIN message-tags server-time")))+27
(assert-equal 3 (length caps))+28
(assert-equal "sasl" (cap-name (car caps)))+29
(assert-equal "PLAIN" (cap-value (car caps)))+30
(assert-equal "message-tags" (cap-name (cadr caps)))+31
(assert-equal #f (cap-value (cadr caps)))))+32
+33
(test "tier-1-caps includes core IRCv3 caps"+34
(let ((t1 (tier-1-caps)))+35
(assert-true (member CAP-SASL t1))+36
(assert-true (member CAP-MESSAGE-TAGS t1))+37
(assert-true (member CAP-SERVER-TIME t1))+38
(assert-true (member CAP-BATCH t1))+39
(assert-true (member CAP-LABELED-RESPONSE t1))+40
(assert-true (member CAP-ECHO-MESSAGE t1))+41
(assert-true (member CAP-EXTENDED-JOIN t1))+42
(assert-true (member CAP-AWAY-NOTIFY t1))))+43
+44
(test "tier-2-caps includes mobile-critical drafts"+45
(let ((t2 (tier-2-caps)))+46
(assert-true (member CAP-CHATHISTORY t2))+47
(assert-true (member CAP-READ-MARKER t2)))))+48
+49
+50
(test-group "CAP client state machine"+51
+52
(test "start emits CAP LS 302"+53
(let ((s (make-cap-client-state desired: '("sasl"))))+54
(assert-equal "CAP LS 302\r\n" (cap-client-start s))+55
(assert-equal 'ls (cap-client-state-phase s))))+56
+57
(test "single-line LS triggers REQ for desired-and-available caps"+58
(let ((s (make-cap-client-state desired: '("sasl" "message-tags" "missing"))))+59
(cap-client-start s)+60
(let* ((ls-msg (parse-irc-message+61
":server CAP * LS :sasl=PLAIN message-tags server-time"))+62
(out (cap-client-advance s ls-msg)))+63
(assert-equal 'req (cap-client-state-phase s))+64
(assert-equal 1 (length out))+65
;; Should have requested both desired-and-supported caps+66
(assert-true (or (string=? (car out) "CAP REQ :sasl message-tags\r\n")+67
(string=? (car out) "CAP REQ :message-tags sasl\r\n"))))))+68
+69
(test "multi-line LS waits for terminator before REQ"+70
(let ((s (make-cap-client-state desired: '("sasl" "server-time"))))+71
(cap-client-start s)+72
(let* ((m1 (parse-irc-message ":server CAP * LS * :sasl=PLAIN"))+73
(out1 (cap-client-advance s m1)))+74
;; Continuation line: no REQ yet.+75
(assert-equal '() out1)+76
(assert-equal 'ls (cap-client-state-phase s))+77
(let* ((m2 (parse-irc-message ":server CAP * LS :server-time"))+78
(out2 (cap-client-advance s m2)))+79
(assert-equal 'req (cap-client-state-phase s))+80
(assert-equal 1 (length out2))))))+81
+82
(test "ACK transitions to done and emits CAP END"+83
(let ((s (make-cap-client-state desired: '("sasl"))))+84
(cap-client-start s)+85
(cap-client-advance s (parse-irc-message ":s CAP * LS :sasl"))+86
(let ((out (cap-client-advance s (parse-irc-message ":s CAP * ACK :sasl"))))+87
(assert-equal 'done (cap-client-state-phase s))+88
(assert-equal 1 (length out))+89
(assert-equal "CAP END\r\n" (car out))+90
(assert-true (member "sasl" (cap-client-state-acked s))))))+91
+92
(test "NAK records nakked caps and ends"+93
(let ((s (make-cap-client-state desired: '("sasl" "message-tags"))))+94
(cap-client-start s)+95
(cap-client-advance s (parse-irc-message ":s CAP * LS :sasl message-tags"))+96
(cap-client-advance s (parse-irc-message ":s CAP * NAK :sasl"))+97
(assert-equal 'done (cap-client-state-phase s))+98
(assert-true (member "sasl" (cap-client-state-nakked s)))))+99
+100
(test "no overlap means immediate CAP END (no REQ)"+101
(let ((s (make-cap-client-state desired: '("nonexistent"))))+102
(cap-client-start s)+103
(let ((out (cap-client-advance s (parse-irc-message ":s CAP * LS :sasl"))))+104
(assert-equal 'done (cap-client-state-phase s))+105
(assert-equal 1 (length out))+106
(assert-equal "CAP END\r\n" (car out))))))+107
+108
+109
(test-group "CAP server state machine"+110
+111
(define (make-server)+112
(make-cap-server-state+113
server-name: "enclave.example"+114
supported: (list (make-cap "sasl" value: "PLAIN,EXTERNAL")+115
(make-cap "message-tags")+116
(make-cap "server-time")+117
(make-cap "batch")+118
(make-cap "echo-message"))))+119
+120
(test "answers CAP LS 302 with supported list"+121
(let* ((s (make-server))+122
(out (cap-server-advance s (parse-irc-message "CAP LS 302")+123
client-nick: "*")))+124
(assert-equal 1 (length out))+125
(assert-equal 'ls-sent (cap-server-state-phase s))+126
(assert-true (cap-server-state-cap-302 s))+127
;; Reply must be ":<server> CAP * LS :<caps>\r\n"+128
(let ((line (car out)))+129
(assert-true (or (string-contains? line "sasl=PLAIN,EXTERNAL")+130
(string-contains? line "sasl"))))))+131
+132
(test "ACKs valid CAP REQ and updates enabled set"+133
(let ((s (make-server)))+134
(cap-server-advance s (parse-irc-message "CAP LS 302"))+135
(let ((out (cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))))+136
(assert-equal 1 (length out))+137
(assert-true (string-contains? (car out) "ACK"))+138
(assert-true (member "sasl" (cap-server-state-enabled s)))+139
(assert-true (member "message-tags" (cap-server-state-enabled s))))))+140
+141
(test "NAKs unknown CAP REQ atomically"+142
(let ((s (make-server)))+143
(cap-server-advance s (parse-irc-message "CAP LS 302"))+144
(let ((out (cap-server-advance s (parse-irc-message "CAP REQ :sasl bogus-cap"))))+145
(assert-equal 1 (length out))+146
(assert-true (string-contains? (car out) "NAK"))+147
;; Atomic — neither cap should be enabled.+148
(assert-false (member "sasl" (cap-server-state-enabled s))))))+149
+150
(test "CAP REQ with -name disables previously-enabled cap"+151
(let ((s (make-server)))+152
(cap-server-advance s (parse-irc-message "CAP LS 302"))+153
(cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))+154
(cap-server-advance s (parse-irc-message "CAP REQ :-sasl"))+155
(assert-false (member "sasl" (cap-server-state-enabled s)))+156
(assert-true (member "message-tags" (cap-server-state-enabled s)))))+157
+158
(test "CAP END transitions to done"+159
(let ((s (make-server)))+160
(cap-server-advance s (parse-irc-message "CAP LS 302"))+161
(cap-server-advance s (parse-irc-message "CAP REQ :sasl"))+162
(cap-server-advance s (parse-irc-message "CAP END"))+163
(assert-equal 'done (cap-server-state-phase s))))+164
+165
(test "CAP LIST returns currently-enabled caps"+166
(let ((s (make-server)))+167
(cap-server-advance s (parse-irc-message "CAP LS 302"))+168
(cap-server-advance s (parse-irc-message "CAP REQ :sasl message-tags"))+169
(let ((out (cap-server-advance s (parse-irc-message "CAP LIST"))))+170
(assert-equal 1 (length out))+171
(assert-true (string-contains? (car out) "LIST"))+172
(assert-true (string-contains? (car out) "sasl"))))))+173
+174
(run-tests)