Commite4dd96b1Recorded27 Apr 2026Repositorysigil-irc
Add Tier 2 caps: batch, chathistory, read-marker, MONITOR
Message
(sigil irc batch) — BATCH command + tag helpers: batch-start-line reftag type [params:] [prefix:] batch-end-line reftag [prefix:] make-batch-reftag — server-side reftag generator (URL-safe) batch-context — client-side tracker for open batches batch-tag-of msg — extract batch tag value batch-type-of ctx reftag — look up the type of an open batch
(sigil irc chathistory) — query parsing + serialization for the draft/chathistory capability. All six subcommands: BEFORE, AFTER, LATEST, AROUND, BETWEEN — target + selector(s) + limit TARGETS — two selectors + limit (no target arg)
Selector forms: timestamp=<RFC-3339>, msgid=<id>, *
parse-chathistory-line + chathistory-line round-trip cleanly.
FAIL standard-reply error codes:
INVALID_PARAMS, INVALID_TARGET, MESSAGE_ERROR, NEED_MORE_PARAMS(sigil irc read-marker) — MARKREAD parser + builders for the draft/read-marker capability (cross-device "last-read" sync). Query form: MARKREAD <target> Set form: MARKREAD <target> timestamp=<RFC-3339> Server echoes the set form back to all sessions of the same account so the marker propagates.
(sigil irc monitor) — MONITOR subcommand parsing (+/-, C, L, S) + server-side numeric reply builders: RPL-MONONLINE (730) — online presence with userhost RPL-MONOFFLINE (731) — offline presence (nick only) RPL-MONLIST (732) — list response chunk RPL-ENDOFMONLIST (733) ERR-MONLISTFULL (734) — server's per-user limit hit
Changed
src/sigil/irc/batch.sgl | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/irc/chathistory.sgl | 263 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/irc/monitor.sgl | 181 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/irc/read-marker.sgl | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-batch.sgl | 78 ++++++++++++++++++++++++++++++++++++++++++++++++
test/test-chathistory.sgl | 122 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-monitor.sgl | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-read-marker.sgl | 57 +++++++++++++++++++++++++++++++++++
8 files changed, 1057 insertions(+)Diff
src/sigil/irc/batch.sgladded
@@ -0,0 +1,164 @@
+1
;;; (sigil irc batch) - IRCv3 batch tag and BATCH command helpers+2
;;;+3
;;; The IRCv3 `batch` capability lets a server group related messages+4
;;; into a single batch identified by a reference tag. Clients that+5
;;; negotiate `batch` see:+6
;;;+7
;;; :server BATCH +<reftag> <batch-type> [params...]+8
;;; @batch=<reftag> :sender PRIVMSG #chan :line 1+9
;;; @batch=<reftag> :sender PRIVMSG #chan :line 2+10
;;; :server BATCH -<reftag>+11
;;;+12
;;; Reftags are server-chosen short strings unique within an open-batch+13
;;; window on a connection. Common batch types include `chathistory`,+14
;;; `netsplit`, `netjoin`, `multiline`, and the read-marker batch+15
;;; defined by the chathistory spec.+16
;;;+17
;;; This module provides:+18
;;;+19
;;; - The `batch` capability constant+20
;;; - Helpers to build BATCH start/end lines+21
;;; - A `batch-context` record to track open batches when receiving+22
;;; - A reftag generator suitable for server use+23
+24
(define-library (sigil irc batch)+25
(import (sigil core)+26
(sigil string)+27
(sigil struct)+28
(sigil crypto)+29
(sigil irc message))+30
+31
(export+32
;; Wire helpers+33
batch-start-line+34
batch-end-line+35
+36
;; Reftag generation (server-side)+37
make-batch-reftag+38
+39
;; Reception side: track open batches+40
batch-context+41
batch-context?+42
make-batch-context+43
batch-context-open-tags+44
batch-context-types+45
batch-context-open?+46
batch-open!+47
batch-close!+48
batch-tag-of+49
batch-type-of)+50
+51
(begin+52
+53
;;; Build a `BATCH +<reftag> <type> [params...]` opening line.+54
;;; `prefix` is the optional source (typically the server name).+55
;;;+56
;;; ```scheme+57
;;; (batch-start-line "abc123" "chathistory" params: '("#channel"))+58
;;; ; => "BATCH +abc123 chathistory #channel\r\n"+59
;;; ```+60
(define (batch-start-line reftag type (keys: (params '()) (prefix #f)))+61
(: string? string? (params: list?) (prefix: any?) -> string?)+62
(let* ((prefix-part (if prefix (string-append ":" prefix " ") ""))+63
(param-part (if (null? params)+64
""+65
(string-append " " (string-join params " ")))))+66
(string-append prefix-part+67
"BATCH +"+68
reftag+69
" "+70
type+71
param-part+72
"\r\n")))+73
+74
;;; Build a `BATCH -<reftag>` closing line.+75
(define (batch-end-line reftag (keys: (prefix #f)))+76
(: string? (prefix: any?) -> string?)+77
(let ((prefix-part (if prefix (string-append ":" prefix " ") "")))+78
(string-append prefix-part "BATCH -" reftag "\r\n")))+79
+80
+81
;; ============================================================+82
;; Reftag generation+83
;; ============================================================+84
+85
;;; Generate a fresh batch reference tag. The tag is opaque to+86
;;; clients, must be unique among currently-open batches on the+87
;;; connection, and is conventionally short (10-16 chars). We use+88
;;; 8 random bytes base64-encoded with the trailing `=` stripped,+89
;;; yielding 11 URL-safe-ish chars.+90
(define (make-batch-reftag)+91
(: -> string?)+92
(let* ((bytes (random-bytes 8))+93
(encoded (base64-encode bytes)))+94
;; Strip any padding `=` and replace `+` / `/` with safe chars.+95
(string-replace+96
(string-replace+97
(string-replace encoded "=" "")+98
"+" "x")+99
"/" "y")))+100
+101
+102
;; ============================================================+103
;; Reception-side context+104
;; ============================================================+105
;;+106
;; Clients (and servers receiving messages-in-batches from peers,+107
;; e.g. for plug-in features) want to know "is this PRIVMSG part of+108
;; an open batch, and if so, of what type?" The batch context+109
;; tracks open reftags and their types, populated as BATCH +/-+110
;; lines arrive.+111
+112
(define-struct batch-context+113
;; alist of reftag -> #t (just open-set membership)+114
(open-tags default: '() mutable: #t)+115
;; alist of reftag -> batch-type-string+116
(types default: '() mutable: #t))+117
+118
(define (make-batch-context)+119
(: -> batch-context?)+120
(batch-context))+121
+122
(define (batch-context-open? ctx reftag)+123
(: batch-context? string? -> boolean?)+124
(let loop ((xs (batch-context-open-tags ctx)))+125
(cond+126
((null? xs) #f)+127
((equal? (caar xs) reftag) #t)+128
(else (loop (cdr xs))))))+129
+130
;;; Record a BATCH start. `reftag` is parsed by the consumer (the+131
;;; leading `+` is stripped). `type` is the batch type string.+132
(define (batch-open! ctx reftag type)+133
(: batch-context? string? string? -> void?)+134
(set-batch-context-open-tags!+135
ctx (cons (cons reftag #t) (batch-context-open-tags ctx)))+136
(set-batch-context-types!+137
ctx (cons (cons reftag type) (batch-context-types ctx))))+138
+139
;;; Record a BATCH end. `reftag` should be the bare reftag (no `-`).+140
(define (batch-close! ctx reftag)+141
(: batch-context? string? -> void?)+142
(set-batch-context-open-tags!+143
ctx (filter (lambda (e) (not (equal? (car e) reftag)))+144
(batch-context-open-tags ctx)))+145
(set-batch-context-types!+146
ctx (filter (lambda (e) (not (equal? (car e) reftag)))+147
(batch-context-types ctx))))+148
+149
;;; If a message has a `batch` tag, return its reftag string.+150
(define (batch-tag-of msg)+151
(: irc-message? -> any?)+152
(let ((v (irc-message-tag msg "batch")))+153
(and (string? v) v)))+154
+155
;;; Look up the batch type associated with a reftag in the context.+156
(define (batch-type-of ctx reftag)+157
(: batch-context? string? -> any?)+158
(let loop ((xs (batch-context-types ctx)))+159
(cond+160
((null? xs) #f)+161
((equal? (caar xs) reftag) (cdar xs))+162
(else (loop (cdr xs))))))+163
+164
))src/sigil/irc/chathistory.sgladded
@@ -0,0 +1,263 @@
+1
;;; (sigil irc chathistory) - CHATHISTORY command helpers (IRCv3 draft)+2
;;;+3
;;; CHATHISTORY lets clients query history without disconnecting. The+4
;;; capability tag `draft/chathistory` advertises a `chathistory=<MAX>`+5
;;; integer for the server's per-query message limit.+6
;;;+7
;;; Subcommands (per https://ircv3.net/specs/extensions/chathistory):+8
;;;+9
;;; CHATHISTORY BEFORE <target> <selector> <limit>+10
;;; CHATHISTORY AFTER <target> <selector> <limit>+11
;;; CHATHISTORY LATEST <target> <selector> <limit>+12
;;; CHATHISTORY AROUND <target> <selector> <limit>+13
;;; CHATHISTORY BETWEEN <target> <selector1> <selector2> <limit>+14
;;; CHATHISTORY TARGETS <selector1> <selector2> <limit>+15
;;;+16
;;; A selector is one of:+17
;;;+18
;;; timestamp=<RFC-3339-UTC>+19
;;; msgid=<msgid-string>+20
;;; * (means "current" / endpoint)+21
;;;+22
;;; Server responses are wrapped in a `chathistory` batch tagged with+23
;;; the `target` channel/nick (a single param after the type), and the+24
;;; messages within it carry their original `msgid` and `time` tags so+25
;;; the client can re-anchor its view.+26
;;;+27
;;; Failures use the IRCv3 standard-replies format:+28
;;;+29
;;; FAIL CHATHISTORY <error-code> <subcommand> [<params>...] :<text>+30
;;;+31
;;; with `<error-code>` from a small enum: INVALID_PARAMS, INVALID_TARGET,+32
;;; MESSAGE_ERROR, NEED_MORE_PARAMS.+33
;;;+34
;;; This module provides:+35
;;;+36
;;; - Subcommand and selector enumerated constants+37
;;; - A `chathistory-query` record + parser/serializer for the+38
;;; client→server line+39
;;; - Helpers to build the server's batch+messages response+40
;;; - Helpers to build the FAIL standard-reply+41
+42
(define-library (sigil irc chathistory)+43
(import (sigil core)+44
(sigil string)+45
(sigil struct)+46
(sigil irc message)+47
(sigil irc batch))+48
+49
(export+50
;; Capability + batch type+51
CHATHISTORY-BATCH-TYPE+52
+53
;; Subcommand strings+54
CHATHISTORY-BEFORE+55
CHATHISTORY-AFTER+56
CHATHISTORY-LATEST+57
CHATHISTORY-AROUND+58
CHATHISTORY-BETWEEN+59
CHATHISTORY-TARGETS+60
+61
;; FAIL error codes+62
CHATHISTORY-FAIL-INVALID-PARAMS+63
CHATHISTORY-FAIL-INVALID-TARGET+64
CHATHISTORY-FAIL-MESSAGE-ERROR+65
CHATHISTORY-FAIL-NEED-MORE-PARAMS+66
+67
;; Selector parser + record+68
chathistory-selector+69
chathistory-selector?+70
make-chathistory-selector+71
chathistory-selector-kind+72
chathistory-selector-value+73
parse-chathistory-selector+74
chathistory-selector->string+75
+76
;; Query record+77
chathistory-query+78
chathistory-query?+79
chathistory-query-subcommand+80
chathistory-query-target+81
chathistory-query-selector1+82
chathistory-query-selector2+83
chathistory-query-limit+84
parse-chathistory-line+85
chathistory-line)+86
+87
(begin+88
+89
(define CHATHISTORY-BATCH-TYPE "chathistory")+90
+91
(define CHATHISTORY-BEFORE "BEFORE")+92
(define CHATHISTORY-AFTER "AFTER")+93
(define CHATHISTORY-LATEST "LATEST")+94
(define CHATHISTORY-AROUND "AROUND")+95
(define CHATHISTORY-BETWEEN "BETWEEN")+96
(define CHATHISTORY-TARGETS "TARGETS")+97
+98
(define CHATHISTORY-FAIL-INVALID-PARAMS "INVALID_PARAMS")+99
(define CHATHISTORY-FAIL-INVALID-TARGET "INVALID_TARGET")+100
(define CHATHISTORY-FAIL-MESSAGE-ERROR "MESSAGE_ERROR")+101
(define CHATHISTORY-FAIL-NEED-MORE-PARAMS "NEED_MORE_PARAMS")+102
+103
+104
;; ============================================================+105
;; Selector+106
;; ============================================================+107
+108
;;; Selectors identify positions in history. `kind` is one of:+109
;;;+110
;;; 'timestamp value is an RFC 3339 UTC timestamp string+111
;;; 'msgid value is a server-assigned msgid string+112
;;; 'star value is #f (selector is `*`, meaning "now")+113
;;;+114
(define-struct chathistory-selector+115
(kind)+116
(value default: #f))+117
+118
(define (make-chathistory-selector kind value)+119
(: symbol? any? -> chathistory-selector?)+120
(chathistory-selector kind: kind value: value))+121
+122
;;; Parse a single selector token. Returns a selector record on+123
;;; success or `#f` on malformed input.+124
(define (parse-chathistory-selector token)+125
(: string? -> any?)+126
(cond+127
((string=? token "*")+128
(chathistory-selector kind: 'star value: #f))+129
((string-starts-with? token "timestamp=")+130
(chathistory-selector+131
kind: 'timestamp+132
value: (substring token 10 (string-length token))))+133
((string-starts-with? token "msgid=")+134
(chathistory-selector+135
kind: 'msgid+136
value: (substring token 6 (string-length token))))+137
(else #f)))+138
+139
;;; Serialize a selector back to its wire form.+140
(define (chathistory-selector->string sel)+141
(: chathistory-selector? -> string?)+142
(case (chathistory-selector-kind sel)+143
((star) "*")+144
((timestamp)+145
(string-append "timestamp=" (chathistory-selector-value sel)))+146
((msgid)+147
(string-append "msgid=" (chathistory-selector-value sel)))+148
(else (error "chathistory-selector->string: bad kind"))))+149
+150
+151
;; ============================================================+152
;; Query record + parsing+153
;; ============================================================+154
+155
;;; A parsed CHATHISTORY query.+156
;;;+157
;;; subcommand: string, one of CHATHISTORY-* constants+158
;;; target: string, channel or nick (#f for TARGETS subcommand)+159
;;; selector1: chathistory-selector+160
;;; selector2: chathistory-selector or #f (BETWEEN/TARGETS only)+161
;;; limit: integer+162
(define-struct chathistory-query+163
(subcommand)+164
(target default: #f)+165
(selector1)+166
(selector2 default: #f)+167
(limit default: 100))+168
+169
+170
;;; Parse an incoming CHATHISTORY message into a query record.+171
;;; Returns the query on success, or `#f` if malformed.+172
;;;+173
;;; ```scheme+174
;;; (parse-chathistory-line+175
;;; (parse-irc-message "CHATHISTORY BEFORE #chan timestamp=2026-04-27T12:00:00Z 50"))+176
;;; ; => #<chathistory-query subcommand: "BEFORE" target: "#chan"+177
;;; ; selector1: #<sel timestamp> selector2: #f limit: 50>+178
;;; ```+179
(define (parse-chathistory-line msg)+180
(: irc-message? -> any?)+181
(let ((cmd (irc-message-command msg))+182
(params (irc-message-params msg)))+183
(cond+184
((not (eq? cmd 'CHATHISTORY)) #f)+185
((null? params) #f)+186
(else+187
(let ((sub (string-upcase (car params)))+188
(rest (cdr params)))+189
(cond+190
((string=? sub CHATHISTORY-TARGETS)+191
;; CHATHISTORY TARGETS <selector1> <selector2> <limit>+192
(and (= (length rest) 3)+193
(let ((s1 (parse-chathistory-selector (car rest)))+194
(s2 (parse-chathistory-selector (cadr rest)))+195
(lim (string->number (caddr rest))))+196
(and s1 s2 lim+197
(chathistory-query+198
subcommand: sub+199
target: #f+200
selector1: s1+201
selector2: s2+202
limit: lim)))))+203
((string=? sub CHATHISTORY-BETWEEN)+204
;; BETWEEN <target> <selector1> <selector2> <limit>+205
(and (= (length rest) 4)+206
(let ((tgt (car rest))+207
(s1 (parse-chathistory-selector (cadr rest)))+208
(s2 (parse-chathistory-selector (caddr rest)))+209
(lim (string->number (cadddr rest))))+210
(and s1 s2 lim+211
(chathistory-query+212
subcommand: sub+213
target: tgt+214
selector1: s1+215
selector2: s2+216
limit: lim)))))+217
((or (string=? sub CHATHISTORY-BEFORE)+218
(string=? sub CHATHISTORY-AFTER)+219
(string=? sub CHATHISTORY-LATEST)+220
(string=? sub CHATHISTORY-AROUND))+221
;; <SUB> <target> <selector> <limit>+222
(and (= (length rest) 3)+223
(let ((tgt (car rest))+224
(s1 (parse-chathistory-selector (cadr rest)))+225
(lim (string->number (caddr rest))))+226
(and s1 lim+227
(chathistory-query+228
subcommand: sub+229
target: tgt+230
selector1: s1+231
limit: lim)))))+232
(else #f)))))))+233
+234
;;; Serialize a chathistory-query back to a wire-format CHATHISTORY+235
;;; line (with CRLF). Useful for client-side construction.+236
(define (chathistory-line query)+237
(: chathistory-query? -> string?)+238
(let ((sub (chathistory-query-subcommand query)))+239
(cond+240
((string=? sub CHATHISTORY-TARGETS)+241
(string-append+242
"CHATHISTORY " sub " "+243
(chathistory-selector->string (chathistory-query-selector1 query)) " "+244
(chathistory-selector->string (chathistory-query-selector2 query)) " "+245
(number->string (chathistory-query-limit query))+246
"\r\n"))+247
((string=? sub CHATHISTORY-BETWEEN)+248
(string-append+249
"CHATHISTORY " sub " "+250
(chathistory-query-target query) " "+251
(chathistory-selector->string (chathistory-query-selector1 query)) " "+252
(chathistory-selector->string (chathistory-query-selector2 query)) " "+253
(number->string (chathistory-query-limit query))+254
"\r\n"))+255
(else+256
(string-append+257
"CHATHISTORY " sub " "+258
(chathistory-query-target query) " "+259
(chathistory-selector->string (chathistory-query-selector1 query)) " "+260
(number->string (chathistory-query-limit query))+261
"\r\n")))))+262
+263
))src/sigil/irc/monitor.sgladded
@@ -0,0 +1,181 @@
+1
;;; (sigil irc monitor) - MONITOR command helpers (IRCv3)+2
;;;+3
;;; MONITOR provides efficient online/offline presence tracking. Clients+4
;;; subscribe to a list of nicks and receive RPL-MONONLINE / RPL-MONOFFLINE+5
;;; notifications when those nicks change presence. This replaces the+6
;;; expensive WHOIS-polling pattern.+7
;;;+8
;;; Subcommands (per https://ircv3.net/specs/extensions/monitor):+9
;;;+10
;;; MONITOR + <nick>[,<nick>...] add nicks to your monitor list+11
;;; MONITOR - <nick>[,<nick>...] remove nicks+12
;;; MONITOR C clear list+13
;;; MONITOR L list current monitored nicks+14
;;; MONITOR S fetch current online/offline status+15
;;;+16
;;; Server numerics:+17
;;;+18
;;; 730 (RPL-MONONLINE) "<client> :nick!user@host[,...]" they came online+19
;;; 731 (RPL-MONOFFLINE) "<client> :nick[,...]" they went offline+20
;;; 732 (RPL-MONLIST) "<client> :nick[,...]" list response+21
;;; 733 (RPL-ENDOFMONLIST) "<client> :End of MONITOR list"+22
;;; 734 (ERR-MONLISTFULL) "<client> <limit> <nick>[,...] :Monitor list is full."+23
+24
(define-library (sigil irc monitor)+25
(import (sigil core)+26
(sigil string)+27
(sigil struct)+28
(sigil irc message)+29
(sigil irc numerics))+30
+31
(export+32
;; Subcommand letter constants+33
MONITOR-ADD+34
MONITOR-REMOVE+35
MONITOR-CLEAR+36
MONITOR-LIST+37
MONITOR-STATUS+38
+39
;; Record + parser+40
monitor-command+41
monitor-command?+42
monitor-command-subcommand+43
monitor-command-targets+44
parse-monitor-line+45
monitor-line+46
+47
;; Server reply helpers+48
monitor-online-line+49
monitor-offline-line+50
monitor-list-line+51
monitor-end-of-list-line+52
monitor-list-full-line)+53
+54
(begin+55
+56
(define MONITOR-ADD "+")+57
(define MONITOR-REMOVE "-")+58
(define MONITOR-CLEAR "C")+59
(define MONITOR-LIST "L")+60
(define MONITOR-STATUS "S")+61
+62
+63
;; ============================================================+64
;; Parsed-command record+65
;; ============================================================+66
+67
(define-struct monitor-command+68
(subcommand) ; "+" / "-" / "C" / "L" / "S"+69
(targets default: '())) ; list of nick strings (empty for C/L/S)+70
+71
;;; Parse a MONITOR command into a monitor-command record. Returns+72
;;; `#f` on malformed input.+73
;;;+74
;;; ```scheme+75
;;; (parse-monitor-line (parse-irc-message "MONITOR + alice,bob"))+76
;;; ; => #<monitor-command subcommand: "+" targets: ("alice" "bob")>+77
;;; ```+78
(define (parse-monitor-line msg)+79
(: irc-message? -> any?)+80
(let ((cmd (irc-message-command msg))+81
(params (irc-message-params msg)))+82
(cond+83
((not (eq? cmd 'MONITOR)) #f)+84
((null? params) #f)+85
(else+86
(let ((sub (car params))+87
(rest (cdr params)))+88
(cond+89
((or (string=? sub MONITOR-CLEAR)+90
(string=? sub MONITOR-LIST)+91
(string=? sub MONITOR-STATUS))+92
(monitor-command subcommand: sub))+93
((or (string=? sub MONITOR-ADD)+94
(string=? sub MONITOR-REMOVE))+95
(cond+96
((null? rest) #f)+97
(else+98
(monitor-command+99
subcommand: sub+100
targets: (string-split (car rest) ",")))))+101
(else #f)))))))+102
+103
;;; Build a MONITOR client→server line.+104
;;;+105
;;; ```scheme+106
;;; (monitor-line "+" '("alice" "bob")) ; => "MONITOR + alice,bob\r\n"+107
;;; (monitor-line "C") ; => "MONITOR C\r\n"+108
;;; ```+109
(define (monitor-line sub . targets)+110
(: string? string? ... -> string?)+111
(cond+112
((or (string=? sub MONITOR-CLEAR)+113
(string=? sub MONITOR-LIST)+114
(string=? sub MONITOR-STATUS))+115
(string-append "MONITOR " sub "\r\n"))+116
((null? targets)+117
(error "monitor-line: + and - require at least one target"))+118
(else+119
(string-append "MONITOR " sub " "+120
(string-join (apply append (map listify targets)) ",")+121
"\r\n"))))+122
+123
(define (listify x)+124
(cond+125
((list? x) x)+126
((string? x) (list x))+127
(else (list x))))+128
+129
+130
;; ============================================================+131
;; Server numeric reply builders+132
;; ============================================================+133
+134
(define (monitor-numeric-line server-name code client-nick text)+135
(string-append (if server-name (string-append ":" server-name " ") "")+136
code " "+137
(or client-nick "*") " :"+138
text "\r\n"))+139
+140
;;; Build an RPL-MONONLINE (730) line. `entries` is a list of+141
;;; `nick!user@host` strings. Multiple targets are comma-joined per+142
;;; the spec.+143
(define (monitor-online-line client-nick entries (keys: (server-name #f)))+144
(: any? list? (server-name: any?) -> string?)+145
(monitor-numeric-line server-name RPL-MONONLINE client-nick+146
(string-join entries ",")))+147
+148
;;; Build an RPL-MONOFFLINE (731) line. `nicks` is a list of nick+149
;;; strings.+150
(define (monitor-offline-line client-nick nicks (keys: (server-name #f)))+151
(: any? list? (server-name: any?) -> string?)+152
(monitor-numeric-line server-name RPL-MONOFFLINE client-nick+153
(string-join nicks ",")))+154
+155
;;; Build an RPL-MONLIST (732) line. May be sent multiple times if+156
;;; the list is large.+157
(define (monitor-list-line client-nick nicks (keys: (server-name #f)))+158
(: any? list? (server-name: any?) -> string?)+159
(monitor-numeric-line server-name RPL-MONLIST client-nick+160
(string-join nicks ",")))+161
+162
;;; Build an RPL-ENDOFMONLIST (733) terminator.+163
(define (monitor-end-of-list-line client-nick (keys: (server-name #f)))+164
(: any? (server-name: any?) -> string?)+165
(monitor-numeric-line server-name RPL-ENDOFMONLIST client-nick+166
"End of MONITOR list"))+167
+168
;;; Build an ERR-MONLISTFULL (734) error: server's per-user limit+169
;;; reached. `limit` is the integer limit; `nicks` is the rejected+170
;;; targets.+171
(define (monitor-list-full-line client-nick limit nicks (keys: (server-name #f)))+172
(: any? integer? list? (server-name: any?) -> string?)+173
(let ((prefix (if server-name (string-append ":" server-name " ") "")))+174
(string-append prefix+175
ERR-MONLISTFULL " "+176
(or client-nick "*") " "+177
(number->string limit) " "+178
(string-join nicks ",")+179
" :Monitor list is full.\r\n")))+180
+181
))src/sigil/irc/read-marker.sgladded
@@ -0,0 +1,106 @@
+1
;;; (sigil irc read-marker) - draft/read-marker capability helpers+2
;;;+3
;;; The `draft/read-marker` capability gives clients a way to sync the+4
;;; "last-read" position of a target (channel or nick) across devices.+5
;;; The wire surface is two messages:+6
;;;+7
;;; C: MARKREAD <target> [timestamp=<RFC-3339-UTC>]+8
;;; S: MARKREAD <target> timestamp=<RFC-3339-UTC>+9
;;;+10
;;; A query (no timestamp) asks the server for the current value. A+11
;;; set (with timestamp) updates the server's stored value, and the+12
;;; server echoes the new state back to all sessions of the same+13
;;; account so other devices learn the new marker.+14
;;;+15
;;; Spec: https://ircv3.net/specs/extensions/read-marker+16
+17
(define-library (sigil irc read-marker)+18
(import (sigil core)+19
(sigil string)+20
(sigil struct)+21
(sigil irc message))+22
+23
(export+24
;; Capability constant (reused from (sigil irc capability) but+25
;; exported here for convenience when this is the only feature+26
;; the consumer cares about)+27
READ-MARKER-CAP+28
+29
;; Record + parser+30
read-marker+31
read-marker?+32
make-read-marker+33
read-marker-target+34
read-marker-timestamp+35
parse-markread-line+36
+37
;; Wire builders+38
markread-query-line+39
markread-set-line)+40
+41
(begin+42
+43
(define READ-MARKER-CAP "draft/read-marker")+44
+45
;;; A single read-marker datum: target string + optional timestamp.+46
;;; A query has timestamp `#f`; an updated/echoed marker carries+47
;;; an RFC 3339 UTC timestamp.+48
(define-struct read-marker+49
(target)+50
(timestamp default: #f))+51
+52
(define (make-read-marker target (keys: (timestamp #f)))+53
(: string? (timestamp: any?) -> read-marker?)+54
(read-marker target: target timestamp: timestamp))+55
+56
;;; Parse a `MARKREAD <target> [timestamp=...]` line. Accepts both+57
;;; the client→server form (timestamp optional) and the+58
;;; server→client form (timestamp present). Returns a read-marker+59
;;; record on success, `#f` on malformed input.+60
(define (parse-markread-line msg)+61
(: irc-message? -> any?)+62
(let ((cmd (irc-message-command msg))+63
(params (irc-message-params msg)))+64
(cond+65
((not (eq? cmd 'MARKREAD)) #f)+66
((null? params) #f)+67
((= (length params) 1)+68
(read-marker target: (car params)))+69
((= (length params) 2)+70
(let ((target (car params))+71
(ts-token (cadr params)))+72
(cond+73
((string-starts-with? ts-token "timestamp=")+74
(read-marker+75
target: target+76
timestamp: (substring ts-token 10 (string-length ts-token))))+77
(else #f))))+78
(else #f))))+79
+80
;;; Build a query line: client asking the server for the current+81
;;; marker for `target`.+82
;;;+83
;;; ```scheme+84
;;; (markread-query-line "#channel")+85
;;; ; => "MARKREAD #channel\r\n"+86
;;; ```+87
(define (markread-query-line target)+88
(: string? -> string?)+89
(string-append "MARKREAD " target "\r\n"))+90
+91
;;; Build a set/echo line: client setting (or server echoing) a+92
;;; marker. `timestamp` is an RFC 3339 UTC string.+93
;;;+94
;;; ```scheme+95
;;; (markread-set-line "#channel" "2026-04-27T12:00:00.000Z")+96
;;; ; => "MARKREAD #channel timestamp=2026-04-27T12:00:00.000Z\r\n"+97
;;; ```+98
(define (markread-set-line target timestamp (keys: (prefix #f)))+99
(: string? string? (prefix: any?) -> string?)+100
(let ((prefix-part (if prefix (string-append ":" prefix " ") "")))+101
(string-append prefix-part+102
"MARKREAD " target+103
" timestamp=" timestamp+104
"\r\n")))+105
+106
))test/test-batch.sgladded
@@ -0,0 +1,78 @@
+1
;;; Tests for BATCH command and batch context tracking.+2
+3
(import (sigil test)+4
(sigil irc message)+5
(sigil irc batch))+6
+7
(test-group "BATCH wire helpers"+8
+9
(test "batch-start-line minimal"+10
(assert-equal "BATCH +abc chathistory\r\n"+11
(batch-start-line "abc" "chathistory")))+12
+13
(test "batch-start-line with params"+14
(assert-equal "BATCH +abc chathistory #channel\r\n"+15
(batch-start-line "abc" "chathistory" params: '("#channel"))))+16
+17
(test "batch-start-line with prefix"+18
(assert-equal ":server BATCH +abc chathistory\r\n"+19
(batch-start-line "abc" "chathistory" prefix: "server")))+20
+21
(test "batch-end-line"+22
(assert-equal "BATCH -abc\r\n" (batch-end-line "abc")))+23
+24
(test "batch-end-line with prefix"+25
(assert-equal ":server BATCH -abc\r\n"+26
(batch-end-line "abc" prefix: "server"))))+27
+28
+29
(test-group "Reftag generation"+30
+31
(test "make-batch-reftag yields a non-empty string"+32
(let ((tag (make-batch-reftag)))+33
(assert-true (string? tag))+34
(assert-true (> (string-length tag) 0))))+35
+36
(test "two reftags differ"+37
(assert-false (string=? (make-batch-reftag) (make-batch-reftag))))+38
+39
(test "reftag avoids `=`, `+`, `/`"+40
(let ((tag (make-batch-reftag)))+41
(assert-false (string-contains? tag "="))+42
(assert-false (string-contains? tag "+"))+43
(assert-false (string-contains? tag "/")))))+44
+45
+46
(test-group "Batch context tracking"+47
+48
(test "open + close lifecycle"+49
(let ((ctx (make-batch-context)))+50
(assert-false (batch-context-open? ctx "abc"))+51
(batch-open! ctx "abc" "chathistory")+52
(assert-true (batch-context-open? ctx "abc"))+53
(assert-equal "chathistory" (batch-type-of ctx "abc"))+54
(batch-close! ctx "abc")+55
(assert-false (batch-context-open? ctx "abc"))+56
(assert-equal #f (batch-type-of ctx "abc"))))+57
+58
(test "multiple open batches"+59
(let ((ctx (make-batch-context)))+60
(batch-open! ctx "a" "chathistory")+61
(batch-open! ctx "b" "netjoin")+62
(assert-true (batch-context-open? ctx "a"))+63
(assert-true (batch-context-open? ctx "b"))+64
(assert-equal "chathistory" (batch-type-of ctx "a"))+65
(assert-equal "netjoin" (batch-type-of ctx "b")))))+66
+67
+68
(test-group "batch-tag-of"+69
+70
(test "extracts batch tag from message"+71
(let ((msg (parse-irc-message "@batch=abc :n!u@h PRIVMSG #c :hi")))+72
(assert-equal "abc" (batch-tag-of msg))))+73
+74
(test "returns #f when batch tag absent"+75
(let ((msg (parse-irc-message ":n!u@h PRIVMSG #c :hi")))+76
(assert-equal #f (batch-tag-of msg)))))+77
+78
(run-tests)test/test-chathistory.sgladded
@@ -0,0 +1,122 @@
+1
;;; Tests for CHATHISTORY query parsing/serialization.+2
+3
(import (sigil test)+4
(sigil irc message)+5
(sigil irc chathistory))+6
+7
(test-group "Chathistory selector parsing"+8
+9
(test "* selector"+10
(let ((s (parse-chathistory-selector "*")))+11
(assert-equal 'star (chathistory-selector-kind s))+12
(assert-equal #f (chathistory-selector-value s))))+13
+14
(test "timestamp= selector"+15
(let ((s (parse-chathistory-selector "timestamp=2026-04-27T12:00:00Z")))+16
(assert-equal 'timestamp (chathistory-selector-kind s))+17
(assert-equal "2026-04-27T12:00:00Z" (chathistory-selector-value s))))+18
+19
(test "msgid= selector"+20
(let ((s (parse-chathistory-selector "msgid=abc-123")))+21
(assert-equal 'msgid (chathistory-selector-kind s))+22
(assert-equal "abc-123" (chathistory-selector-value s))))+23
+24
(test "rejects unknown form"+25
(assert-equal #f (parse-chathistory-selector "garbage"))))+26
+27
+28
(test-group "Chathistory selector serialization"+29
+30
(test "* round-trip"+31
(assert-equal "*"+32
(chathistory-selector->string+33
(parse-chathistory-selector "*"))))+34
+35
(test "timestamp round-trip"+36
(let ((token "timestamp=2026-04-27T12:00:00Z"))+37
(assert-equal token+38
(chathistory-selector->string+39
(parse-chathistory-selector token)))))+40
+41
(test "msgid round-trip"+42
(let ((token "msgid=abc-123"))+43
(assert-equal token+44
(chathistory-selector->string+45
(parse-chathistory-selector token))))))+46
+47
+48
(test-group "parse-chathistory-line"+49
+50
(test "BEFORE query"+51
(let* ((msg (parse-irc-message+52
"CHATHISTORY BEFORE #channel timestamp=2026-04-27T12:00:00Z 50"))+53
(q (parse-chathistory-line msg)))+54
(assert-true q)+55
(assert-equal "BEFORE" (chathistory-query-subcommand q))+56
(assert-equal "#channel" (chathistory-query-target q))+57
(assert-equal 'timestamp+58
(chathistory-selector-kind (chathistory-query-selector1 q)))+59
(assert-equal 50 (chathistory-query-limit q))))+60
+61
(test "LATEST with msgid"+62
(let* ((msg (parse-irc-message+63
"CHATHISTORY LATEST #foo msgid=abc 100"))+64
(q (parse-chathistory-line msg)))+65
(assert-true q)+66
(assert-equal "LATEST" (chathistory-query-subcommand q))+67
(assert-equal 'msgid+68
(chathistory-selector-kind (chathistory-query-selector1 q)))+69
(assert-equal "abc"+70
(chathistory-selector-value (chathistory-query-selector1 q)))))+71
+72
(test "BETWEEN with two selectors"+73
(let* ((msg (parse-irc-message+74
"CHATHISTORY BETWEEN #foo timestamp=2026-04-27T00:00:00Z timestamp=2026-04-27T23:59:59Z 200"))+75
(q (parse-chathistory-line msg)))+76
(assert-true q)+77
(assert-equal "BETWEEN" (chathistory-query-subcommand q))+78
(assert-equal "#foo" (chathistory-query-target q))+79
(assert-true (chathistory-query-selector2 q))+80
(assert-equal 200 (chathistory-query-limit q))))+81
+82
(test "TARGETS query"+83
(let* ((msg (parse-irc-message+84
"CHATHISTORY TARGETS timestamp=2026-04-27T00:00:00Z timestamp=2026-04-28T00:00:00Z 50"))+85
(q (parse-chathistory-line msg)))+86
(assert-true q)+87
(assert-equal "TARGETS" (chathistory-query-subcommand q))+88
(assert-equal #f (chathistory-query-target q))+89
(assert-equal 50 (chathistory-query-limit q))))+90
+91
(test "rejects malformed (missing limit)"+92
(let* ((msg (parse-irc-message "CHATHISTORY BEFORE #foo *"))+93
(q (parse-chathistory-line msg)))+94
(assert-equal #f q)))+95
+96
(test "rejects unknown subcommand"+97
(let* ((msg (parse-irc-message "CHATHISTORY SIDEWAYS #foo * 10"))+98
(q (parse-chathistory-line msg)))+99
(assert-equal #f q))))+100
+101
+102
(test-group "chathistory-line serialization"+103
+104
(test "BEFORE round-trips"+105
(let* ((msg (parse-irc-message+106
"CHATHISTORY BEFORE #channel timestamp=2026-04-27T12:00:00Z 50"))+107
(q (parse-chathistory-line msg))+108
(line (chathistory-line q)))+109
(assert-equal+110
"CHATHISTORY BEFORE #channel timestamp=2026-04-27T12:00:00Z 50\r\n"+111
line)))+112
+113
(test "BETWEEN round-trips"+114
(let* ((msg (parse-irc-message+115
"CHATHISTORY BETWEEN #foo * msgid=xyz 25"))+116
(q (parse-chathistory-line msg))+117
(line (chathistory-line q)))+118
(assert-equal+119
"CHATHISTORY BETWEEN #foo * msgid=xyz 25\r\n"+120
line))))+121
+122
(run-tests)test/test-monitor.sgladded
@@ -0,0 +1,86 @@
+1
;;; Tests for MONITOR command parsing + numeric reply builders.+2
+3
(import (sigil test)+4
(sigil irc message)+5
(sigil irc monitor)+6
(sigil irc numerics))+7
+8
(test-group "MONITOR parsing"+9
+10
(test "MONITOR + with single nick"+11
(let* ((msg (parse-irc-message "MONITOR + alice"))+12
(mc (parse-monitor-line msg)))+13
(assert-true mc)+14
(assert-equal "+" (monitor-command-subcommand mc))+15
(assert-equal '("alice") (monitor-command-targets mc))))+16
+17
(test "MONITOR + with comma list"+18
(let* ((msg (parse-irc-message "MONITOR + alice,bob,carol"))+19
(mc (parse-monitor-line msg)))+20
(assert-true mc)+21
(assert-equal '("alice" "bob" "carol") (monitor-command-targets mc))))+22
+23
(test "MONITOR -"+24
(let* ((msg (parse-irc-message "MONITOR - alice"))+25
(mc (parse-monitor-line msg)))+26
(assert-true mc)+27
(assert-equal "-" (monitor-command-subcommand mc))))+28
+29
(test "MONITOR C / L / S have empty targets"+30
(let ((msg-c (parse-irc-message "MONITOR C"))+31
(msg-l (parse-irc-message "MONITOR L"))+32
(msg-s (parse-irc-message "MONITOR S")))+33
(assert-equal '() (monitor-command-targets (parse-monitor-line msg-c)))+34
(assert-equal '() (monitor-command-targets (parse-monitor-line msg-l)))+35
(assert-equal '() (monitor-command-targets (parse-monitor-line msg-s)))))+36
+37
(test "rejects MONITOR + without targets"+38
(let* ((msg (parse-irc-message "MONITOR +"))+39
(mc (parse-monitor-line msg)))+40
(assert-equal #f mc)))+41
+42
(test "rejects unknown subcommand"+43
(let* ((msg (parse-irc-message "MONITOR Q alice"))+44
(mc (parse-monitor-line msg)))+45
(assert-equal #f mc))))+46
+47
+48
(test-group "MONITOR client line builder"+49
+50
(test "+ list"+51
(assert-equal "MONITOR + alice,bob\r\n"+52
(monitor-line "+" '("alice" "bob"))))+53
+54
(test "C clear"+55
(assert-equal "MONITOR C\r\n" (monitor-line "C")))+56
+57
(test "L list query"+58
(assert-equal "MONITOR L\r\n" (monitor-line "L"))))+59
+60
+61
(test-group "MONITOR server numeric reply builders"+62
+63
(test "RPL-MONONLINE (730)"+64
(let ((line (monitor-online-line "alice"+65
'("bob!b@host" "carol!c@host"))))+66
(assert-true (string-contains? line RPL-MONONLINE))+67
(assert-true (string-contains? line "alice"))+68
(assert-true (string-contains? line "bob!b@host,carol!c@host"))))+69
+70
(test "RPL-MONOFFLINE (731)"+71
(let ((line (monitor-offline-line "alice" '("bob"))))+72
(assert-true (string-contains? line RPL-MONOFFLINE))+73
(assert-true (string-contains? line "bob"))))+74
+75
(test "RPL-ENDOFMONLIST (733)"+76
(let ((line (monitor-end-of-list-line "alice")))+77
(assert-true (string-contains? line RPL-ENDOFMONLIST))+78
(assert-true (string-contains? line "End of MONITOR list"))))+79
+80
(test "ERR-MONLISTFULL (734) includes limit and rejected nicks"+81
(let ((line (monitor-list-full-line "alice" 100 '("dan"))))+82
(assert-true (string-contains? line ERR-MONLISTFULL))+83
(assert-true (string-contains? line "100"))+84
(assert-true (string-contains? line "dan")))))+85
+86
(run-tests)test/test-read-marker.sgladded
@@ -0,0 +1,57 @@
+1
;;; Tests for draft/read-marker MARKREAD helpers.+2
+3
(import (sigil test)+4
(sigil irc message)+5
(sigil irc read-marker))+6
+7
(test-group "MARKREAD parsing"+8
+9
(test "query (target only)"+10
(let* ((msg (parse-irc-message "MARKREAD #channel"))+11
(m (parse-markread-line msg)))+12
(assert-true m)+13
(assert-equal "#channel" (read-marker-target m))+14
(assert-equal #f (read-marker-timestamp m))))+15
+16
(test "set (with timestamp)"+17
(let* ((msg (parse-irc-message+18
"MARKREAD #channel timestamp=2026-04-27T12:00:00.000Z"))+19
(m (parse-markread-line msg)))+20
(assert-true m)+21
(assert-equal "#channel" (read-marker-target m))+22
(assert-equal "2026-04-27T12:00:00.000Z" (read-marker-timestamp m))))+23
+24
(test "echoed from server with prefix"+25
(let* ((msg (parse-irc-message+26
":server MARKREAD #channel timestamp=2026-04-27T12:00:00.000Z"))+27
(m (parse-markread-line msg)))+28
(assert-true m)+29
(assert-equal "2026-04-27T12:00:00.000Z" (read-marker-timestamp m))))+30
+31
(test "rejects malformed timestamp token"+32
(let* ((msg (parse-irc-message "MARKREAD #channel garbage"))+33
(m (parse-markread-line msg)))+34
(assert-equal #f m)))+35
+36
(test "rejects empty params"+37
(let* ((msg (parse-irc-message "MARKREAD"))+38
(m (parse-markread-line msg)))+39
(assert-equal #f m))))+40
+41
+42
(test-group "MARKREAD line builders"+43
+44
(test "query line"+45
(assert-equal "MARKREAD #channel\r\n"+46
(markread-query-line "#channel")))+47
+48
(test "set line without prefix"+49
(assert-equal "MARKREAD #channel timestamp=2026-04-27T12:00:00Z\r\n"+50
(markread-set-line "#channel" "2026-04-27T12:00:00Z")))+51
+52
(test "set line with prefix (server echo)"+53
(assert-equal ":server MARKREAD #channel timestamp=2026-04-27T12:00:00Z\r\n"+54
(markread-set-line "#channel" "2026-04-27T12:00:00Z"+55
prefix: "server"))))+56
+57
(run-tests)