Commit7f306d19Recorded1 Mar 2026Repositorysigil-jmap
Add sigil-jmap package for JMAP email client (RFC 8620/8621)
Message
Implements JMAP session discovery, mailbox operations (list, lookup, create, update, destroy), email query/get/update with back-references for single round-trip queries, and email sending via EmailSubmission/set with automatic Sent folder handling. Includes 21 offline unit tests.
Changed
package.sgl | 17 +++++++++++
src/sigil/jmap.sgl | 77 +++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/jmap/client.sgl | 266 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/jmap/email.sgl | 209 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/jmap/mailbox.sgl | 140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/sigil/jmap/send.sgl | 202 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-jmap.sgl | 273 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
7 files changed, 1184 insertions(+)Diff
package.sgladded
@@ -0,0 +1,17 @@
+1
;;; sigil-jmap - JMAP Email Client Library+2
;;;+3
;;; Provides a JMAP (RFC 8620/8621) client for interacting with+4
;;; email servers like Fastmail, Stalwart, Cyrus, and Apache James.+5
+6
(package+7
name: "sigil-jmap"+8
version: "0.7.0"+9
description: "JMAP email client library for Sigil"+10
url: "https://codeberg.org/sigil/sigil"+11
license: "BSD-3-Clause"+12
authors: (list "David Wilson <[email protected]>")+13
+14
dependencies: (list+15
(from-workspace name: "sigil-stdlib")+16
(from-workspace name: "sigil-json")+17
(from-workspace name: "sigil-http")))src/sigil/jmap.sgladded
@@ -0,0 +1,77 @@
+1
;;; (sigil jmap) - JMAP Email Client Library+2
;;;+3
;;; Provides a complete JMAP client (RFC 8620 core + RFC 8621 mail)+4
;;; for interacting with email servers like Fastmail, Stalwart,+5
;;; Cyrus, and Apache James.+6
;;;+7
;;; ```scheme+8
;;; (import (sigil jmap))+9
;;;+10
;;; (define client (jmap-connect+11
;;; url: "https://api.fastmail.com/.well-known/jmap"+12
;;; token: "fmu1-..."))+13
;;;+14
;;; ;; List mailboxes+15
;;; (map (lambda (mb) (dict-ref mb name:))+16
;;; (jmap-mailboxes client))+17
;;;+18
;;; ;; Query inbox+19
;;; (define inbox (jmap-mailbox-by-role client "inbox"))+20
;;; (jmap-email-query client mailbox: (dict-ref inbox id:) limit: 10)+21
;;;+22
;;; ;; Send an email+23
;;; (jmap-send! client+24
;;; identity-id: (dict-ref (car (jmap-identities client)) id:)+25
;;; to: "[email protected]"+26
;;; subject: "Hello"+27
;;; text-body: "Sent from Sigil!")+28
;;; ```+29
+30
(define-library (sigil jmap)+31
(import (sigil jmap client)+32
(sigil jmap mailbox)+33
(sigil jmap email)+34
(sigil jmap send))+35
+36
(export+37
;; Client (from sigil jmap client)+38
jmap-client+39
jmap-client?+40
jmap-client-session-url+41
jmap-client-auth-header+42
jmap-client-api-url+43
jmap-client-download-url+44
jmap-client-upload-url+45
jmap-client-account-id+46
jmap-client-accounts+47
jmap-client-capabilities+48
jmap-client-session-state+49
jmap-connect+50
jmap-call+51
jmap-request+52
jmap-result-ref+53
jmap-response-get+54
jmap-response-error?+55
jmap-error-type+56
+57
;; Mailbox (from sigil jmap mailbox)+58
jmap-mailboxes+59
jmap-mailbox-by-role+60
jmap-mailbox-by-name+61
jmap-mailbox-create!+62
jmap-mailbox-update!+63
jmap-mailbox-destroy!+64
+65
;; Email (from sigil jmap email)+66
jmap-email-query+67
jmap-email-get+68
jmap-email-get-many+69
jmap-email-update!+70
jmap-email-move!+71
jmap-email-destroy!+72
jmap-email-set-keyword!+73
jmap-email-remove-keyword!+74
+75
;; Send (from sigil jmap send)+76
jmap-identities+77
jmap-send!))src/sigil/jmap/client.sgladded
@@ -0,0 +1,266 @@
+1
;;; (sigil jmap client) - JMAP Client Core+2
;;;+3
;;; Handles JMAP session discovery, request building, and response+4
;;; parsing per RFC 8620. Provides the transport layer for all+5
;;; JMAP method calls.+6
+7
(define-library (sigil jmap client)+8
(import (sigil core)+9
(sigil string)+10
(sigil struct)+11
(sigil http client))+12
+13
(export+14
;; Client struct+15
jmap-client+16
jmap-client?+17
jmap-client-session-url+18
jmap-client-auth-header+19
jmap-client-api-url+20
jmap-client-download-url+21
jmap-client-upload-url+22
jmap-client-account-id+23
jmap-client-accounts+24
jmap-client-capabilities+25
jmap-client-session-state+26
+27
;; Connection+28
jmap-connect+29
+30
;; Request building+31
jmap-call+32
jmap-request+33
jmap-result-ref+34
+35
;; Response helpers+36
jmap-response-get+37
jmap-response-error?+38
jmap-error-type)+39
+40
(begin+41
+42
;; ============================================================+43
;; Client Record+44
;; ============================================================+45
+46
(define-struct jmap-client+47
(session-url string?)+48
(auth-header string?)+49
(api-url default: #f mutable: #t)+50
(download-url default: #f mutable: #t)+51
(upload-url default: #f mutable: #t)+52
(account-id default: #f mutable: #t)+53
(accounts default: #{} mutable: #t)+54
(capabilities default: #{} mutable: #t)+55
(session-state default: #f mutable: #t))+56
+57
+58
;; ============================================================+59
;; Session Discovery+60
;; ============================================================+61
+62
;;; Connect to a JMAP server and discover session capabilities.+63
;;;+64
;;; Fetches the JMAP session resource, populates the client with+65
;;; API URLs, account IDs, and capabilities. Authenticates using+66
;;; either a Bearer token or a pre-built Authorization header.+67
;;;+68
;;; ```scheme+69
;;; (jmap-connect+70
;;; url: "https://api.fastmail.com/.well-known/jmap"+71
;;; token: "fmu1-...")+72
;;;+73
;;; (jmap-connect+74
;;; url: "https://jmap.example.com/.well-known/jmap"+75
;;; auth: "Basic dXNlcjpwYXNz")+76
;;; ```+77
(define (jmap-connect (keys: (url #f) (token #f) (auth #f)))+78
(: (url: string?) (token: any?) (auth: any?) -> jmap-client?)+79
(unless url+80
(error "jmap-connect: url: is required"))+81
(unless (or token auth)+82
(error "jmap-connect: token: or auth: is required"))+83
+84
(let* ((auth-header (if token+85
(string-append "Bearer " token)+86
auth))+87
(client (jmap-client+88
session-url: url+89
auth-header: auth-header))+90
(session (http-get/json url+91
headers: (dict authorization: auth-header))))+92
(unless session+93
(error "jmap-connect: failed to fetch session resource" url))+94
+95
;; Populate client from session+96
(set-jmap-client-api-url! client (dict-ref session apiUrl: #f))+97
(set-jmap-client-download-url! client (dict-ref session downloadUrl: #f))+98
(set-jmap-client-upload-url! client (dict-ref session uploadUrl: #f))+99
(set-jmap-client-session-state! client (dict-ref session state: #f))+100
(set-jmap-client-capabilities! client (or (dict-ref session capabilities: #f) #{}))+101
(set-jmap-client-accounts! client (or (dict-ref session accounts: #f) #{}))+102
+103
;; Find primary mail account+104
(let ((primary-accounts (dict-ref session primaryAccounts: #{})))+105
(let ((mail-account-id (dict-ref primary-accounts+106
(string->keyword "urn:ietf:params:jmap:mail")+107
#f)))+108
(when mail-account-id+109
(set-jmap-client-account-id! client mail-account-id))))+110
+111
client))+112
+113
+114
;; ============================================================+115
;; Request Building+116
;; ============================================================+117
+118
;;; Build a JMAP method call triple.+119
;;;+120
;;; Returns an array of `[method-name, arguments, call-id]` suitable+121
;;; for inclusion in the `methodCalls` array of a JMAP request.+122
;;;+123
;;; ```scheme+124
;;; (jmap-call "Mailbox/get"+125
;;; #{ accountId: "abc123" ids: 'null })+126
;;; ; => #["Mailbox/get" #{ accountId: "abc123" ids: null } "0"]+127
;;;+128
;;; (jmap-call "Email/query"+129
;;; #{ accountId: "abc123" }+130
;;; "q0")+131
;;; ; => #["Email/query" #{ accountId: "abc123" } "q0"]+132
;;; ```+133
(define (jmap-call method args . call-id)+134
(: string? dict? string? ... -> array?)+135
(list->array (list method args (if (pair? call-id) (car call-id) "0"))))+136
+137
;;; Send JMAP method calls to the server.+138
;;;+139
;;; Takes the client and one or more method call triples (from `jmap-call`).+140
;;; Returns the parsed JSON response body, or raises an error on+141
;;; HTTP failure.+142
;;;+143
;;; The `using:` keyword specifies JMAP capability URNs to include.+144
;;; Defaults to core and mail capabilities.+145
;;;+146
;;; ```scheme+147
;;; (jmap-request client+148
;;; (jmap-call "Mailbox/get" #{ accountId: id ids: 'null }))+149
;;; ```+150
(define (jmap-request client (rest: calls) (keys: (using #f)))+151
(: jmap-client? array? ... (using: any?) -> dict?)+152
(let* ((capability-urns (or using+153
(list "urn:ietf:params:jmap:core"+154
"urn:ietf:params:jmap:mail")))+155
(body (dict+156
using: (list->array capability-urns)+157
methodCalls: (list->array calls)))+158
(result (http-post/json+159
(jmap-client-api-url client)+160
body+161
headers: (dict+162
authorization: (jmap-client-auth-header client)))))+163
(unless result+164
(error "jmap-request: HTTP request failed"))+165
+166
;; Update session state if changed+167
(let ((new-state (dict-ref result sessionState: #f)))+168
(when (and new-state+169
(not (equal? new-state (jmap-client-session-state client))))+170
(set-jmap-client-session-state! client new-state)))+171
+172
result))+173
+174
+175
;; ============================================================+176
;; Response Helpers+177
;; ============================================================+178
+179
;;; Extract a method response by call ID from a JMAP response.+180
;;;+181
;;; Searches the `methodResponses` array for a triple matching the+182
;;; given call ID and returns its arguments dict. Returns `#f` if+183
;;; no match is found.+184
;;;+185
;;; ```scheme+186
;;; (jmap-response-get response "0")+187
;;; ; => #{ accountId: "abc" state: "..." list: #[...] }+188
;;; ```+189
(define (jmap-response-get response call-id)+190
(: dict? string? -> any?)+191
(let ((responses (dict-ref response methodResponses: #f)))+192
(and responses+193
(let loop ((i 0))+194
(if (>= i (array-length responses))+195
#f+196
(let ((triple (array-ref responses i)))+197
(if (equal? (array-ref triple 2) call-id)+198
(array-ref triple 1)+199
(loop (+ i 1)))))))))+200
+201
;;; Check if a method response is a JMAP error.+202
;;;+203
;;; Returns `#t` if the response triple for the given call ID has+204
;;; `"error"` as its method name.+205
;;;+206
;;; ```scheme+207
;;; (jmap-response-error? response "0")+208
;;; ; => #f+209
;;; ```+210
(define (jmap-response-error? response call-id)+211
(: dict? string? -> boolean?)+212
(let ((responses (dict-ref response methodResponses: #f)))+213
(and responses+214
(let loop ((i 0))+215
(if (>= i (array-length responses))+216
#f+217
(let ((triple (array-ref responses i)))+218
(if (equal? (array-ref triple 2) call-id)+219
(equal? (array-ref triple 0) "error")+220
(loop (+ i 1)))))))))+221
+222
;;; Get the error type from a JMAP error response.+223
;;;+224
;;; Returns the `type` field from the error arguments, or `#f` if+225
;;; the response is not an error.+226
;;;+227
;;; ```scheme+228
;;; (jmap-error-type response "0")+229
;;; ; => "unknownMethod"+230
;;; ```+231
(define (jmap-error-type response call-id)+232
(: dict? string? -> any?)+233
(let ((responses (dict-ref response methodResponses: #f)))+234
(and responses+235
(let loop ((i 0))+236
(if (>= i (array-length responses))+237
#f+238
(let ((triple (array-ref responses i)))+239
(if (and (equal? (array-ref triple 2) call-id)+240
(equal? (array-ref triple 0) "error"))+241
(dict-ref (array-ref triple 1) type: #f)+242
(loop (+ i 1)))))))))+243
+244
;;; Send a single JMAP method call and return the result directly.+245
;;;+246
;;; Convenience wrapper around `jmap-request` + `jmap-response-get`.+247
;;; Raises an error if the response is a JMAP-level error.+248
;;;+249
;;; ```scheme+250
;;; (jmap-result-ref client+251
;;; (jmap-call "Mailbox/get" #{ accountId: id ids: 'null }))+252
;;; ; => #{ accountId: "abc" state: "..." list: #[...] }+253
;;; ```+254
(define (jmap-result-ref client call (keys: (using #f)))+255
(: jmap-client? array? (using: any?) -> dict?)+256
(let* ((call-id (array-ref call 2))+257
(response (if using+258
(jmap-request client call using: using)+259
(jmap-request client call))))+260
(when (jmap-response-error? response call-id)+261
(let ((err-type (jmap-error-type response call-id)))+262
(error (string-append "JMAP error: " (or err-type "unknown"))+263
(jmap-response-get response call-id))))+264
(jmap-response-get response call-id)))+265
+266
))src/sigil/jmap/email.sgladded
@@ -0,0 +1,209 @@
+1
;;; (sigil jmap email) - JMAP Email Operations+2
;;;+3
;;; Provides email querying, retrieval, and modification via JMAP+4
;;; Email/query, Email/get, and Email/set methods (RFC 8621).+5
+6
(define-library (sigil jmap email)+7
(import (sigil core)+8
(sigil string)+9
(sigil json)+10
(sigil jmap client))+11
+12
(export+13
jmap-email-query+14
jmap-email-get+15
jmap-email-get-many+16
jmap-email-update!+17
jmap-email-move!+18
jmap-email-destroy!+19
jmap-email-set-keyword!+20
jmap-email-remove-keyword!)+21
+22
(begin+23
+24
;; Default properties to fetch for email listings+25
(define %default-list-properties+26
#["id" "threadId" "mailboxIds" "keywords" "from" "to"+27
"subject" "receivedAt" "size" "preview"])+28
+29
;; Full properties for single email retrieval+30
(define %default-full-properties+31
#["id" "threadId" "mailboxIds" "keywords" "from" "to" "cc" "bcc"+32
"replyTo" "subject" "sentAt" "receivedAt" "size" "preview"+33
"textBody" "htmlBody" "attachments" "bodyValues"+34
"messageId" "inReplyTo" "references" "headers"])+35
+36
+37
;; ============================================================+38
;; Email Queries+39
;; ============================================================+40
+41
;;; Query and fetch emails in a single round-trip.+42
;;;+43
;;; Combines `Email/query` and `Email/get` using a JMAP+44
;;; back-reference so the server resolves the query and returns+45
;;; the email objects in one request.+46
;;;+47
;;; Keywords:+48
;;; `mailbox:` - Mailbox ID to query within+49
;;; `filter:` - Custom filter dict (overrides mailbox:)+50
;;; `sort:` - Sort criteria (default: receivedAt descending)+51
;;; `limit:` - Max results (default: 50)+52
;;; `position:` - Offset into results (default: 0)+53
;;; `properties:` - Properties to fetch (default: standard list)+54
;;;+55
;;; Returns a list of email dicts.+56
;;;+57
;;; ```scheme+58
;;; (jmap-email-query client mailbox: inbox-id limit: 10)+59
;;; ```+60
(define (jmap-email-query client+61
(keys: (mailbox #f) (filter #f) (sort #f)+62
(limit 50) (position 0) (properties #f)))+63
(: jmap-client? (mailbox: (maybe string?)) (filter: (maybe dict?))+64
(sort: (maybe list?)) (limit: integer?) (position: integer?)+65
(properties: any?) -> list?)+66
(let* ((account-id (jmap-client-account-id client))+67
(query-filter (or filter+68
(if mailbox+69
(dict inMailbox: mailbox)+70
#{})))+71
(query-sort (or sort+72
(list (dict property: "receivedAt"+73
isAscending: #f))))+74
(props (or properties %default-list-properties))+75
(query-call (jmap-call "Email/query"+76
(dict accountId: account-id+77
filter: query-filter+78
sort: (list->array query-sort)+79
limit: limit+80
position: position)+81
"q0"))+82
;; Back-reference: use query result IDs+83
(get-call (jmap-call "Email/get"+84
(dict accountId: account-id+85
(string->keyword "#ids"):+86
(dict resultOf: "q0"+87
name: "Email/query"+88
path: "/ids")+89
properties: props)+90
"g0"))+91
(response (jmap-request client query-call get-call)))+92
;; Check for errors+93
(when (jmap-response-error? response "q0")+94
(error "jmap-email-query: query failed"+95
(jmap-error-type response "q0")))+96
(when (jmap-response-error? response "g0")+97
(error "jmap-email-query: get failed"+98
(jmap-error-type response "g0")))+99
(let ((get-result (jmap-response-get response "g0")))+100
(if get-result+101
(array->list (or (dict-ref get-result list: #f) #[]))+102
'()))))+103
+104
;;; Get a single email by ID with full body content.+105
;;;+106
;;; Returns the email dict with body values, or `#f` if not found.+107
;;;+108
;;; ```scheme+109
;;; (define email (jmap-email-get client email-id))+110
;;; (dict-ref email subject:)+111
;;; ```+112
(define (jmap-email-get client email-id (keys: (properties #f)))+113
(: jmap-client? string? (properties: any?) -> (maybe dict?))+114
(let* ((props (or properties %default-full-properties))+115
(result (jmap-result-ref client+116
(jmap-call "Email/get"+117
(dict accountId: (jmap-client-account-id client)+118
ids: #[email-id]+119
properties: props+120
fetchAllBodyValues: #t)))))+121
(let ((emails (array->list (or (dict-ref result list: #f) #[]))))+122
(if (pair? emails) (car emails) #f))))+123
+124
;;; Get multiple emails by their IDs.+125
;;;+126
;;; Returns a list of email dicts.+127
;;;+128
;;; ```scheme+129
;;; (jmap-email-get-many client '("id1" "id2" "id3"))+130
;;; ```+131
(define (jmap-email-get-many client email-ids (keys: (properties #f)))+132
(: jmap-client? list? (properties: any?) -> list?)+133
(let* ((props (or properties %default-list-properties))+134
(result (jmap-result-ref client+135
(jmap-call "Email/get"+136
(dict accountId: (jmap-client-account-id client)+137
ids: (list->array email-ids)+138
properties: props)))))+139
(array->list (or (dict-ref result list: #f) #[]))))+140
+141
+142
;; ============================================================+143
;; Email Mutations+144
;; ============================================================+145
+146
;;; Update an email's properties.+147
;;;+148
;;; The `updates` dict contains JMAP patch operations.+149
;;;+150
;;; ```scheme+151
;;; (jmap-email-update! client email-id+152
;;; #{ (string->keyword "keywords/$seen"): #t })+153
;;; ```+154
(define (jmap-email-update! client email-id updates)+155
(: jmap-client? string? dict? -> dict?)+156
(jmap-result-ref client+157
(jmap-call "Email/set"+158
(dict accountId: (jmap-client-account-id client)+159
update: (dict-set #{} (string->keyword email-id) updates)))))+160
+161
;;; Move an email to a different mailbox.+162
;;;+163
;;; Replaces all current mailbox assignments with the target mailbox.+164
;;;+165
;;; ```scheme+166
;;; (jmap-email-move! client email-id trash-id)+167
;;; ```+168
(define (jmap-email-move! client email-id target-mailbox-id)+169
(: jmap-client? string? string? -> dict?)+170
(jmap-email-update! client email-id+171
(dict mailboxIds: (dict-set #{} (string->keyword target-mailbox-id) #t))))+172
+173
;;; Delete an email permanently.+174
;;;+175
;;; ```scheme+176
;;; (jmap-email-destroy! client email-id)+177
;;; ```+178
(define (jmap-email-destroy! client email-id)+179
(: jmap-client? string? -> dict?)+180
(jmap-result-ref client+181
(jmap-call "Email/set"+182
(dict accountId: (jmap-client-account-id client)+183
destroy: #[email-id]))))+184
+185
;;; Set a keyword on an email.+186
;;;+187
;;; Common keywords: `"$seen"`, `"$flagged"`, `"$draft"`,+188
;;; `"$answered"`, `"$forwarded"`.+189
;;;+190
;;; ```scheme+191
;;; (jmap-email-set-keyword! client email-id "$seen")+192
;;; (jmap-email-set-keyword! client email-id "$flagged")+193
;;; ```+194
(define (jmap-email-set-keyword! client email-id keyword)+195
(: jmap-client? string? string? -> dict?)+196
(jmap-email-update! client email-id+197
(dict-set #{} (string->keyword (string-append "keywords/" keyword)) #t)))+198
+199
;;; Remove a keyword from an email.+200
;;;+201
;;; ```scheme+202
;;; (jmap-email-remove-keyword! client email-id "$seen")+203
;;; ```+204
(define (jmap-email-remove-keyword! client email-id keyword)+205
(: jmap-client? string? string? -> dict?)+206
(jmap-email-update! client email-id+207
(dict-set #{} (string->keyword (string-append "keywords/" keyword)) #f)))+208
+209
))src/sigil/jmap/mailbox.sgladded
@@ -0,0 +1,140 @@
+1
;;; (sigil jmap mailbox) - JMAP Mailbox Operations+2
;;;+3
;;; Provides mailbox listing, lookup, creation, update, and deletion+4
;;; via JMAP Mailbox/get and Mailbox/set methods (RFC 8621).+5
+6
(define-library (sigil jmap mailbox)+7
(import (sigil core)+8
(sigil string)+9
(sigil json)+10
(sigil jmap client))+11
+12
(export+13
jmap-mailboxes+14
jmap-mailbox-by-role+15
jmap-mailbox-by-name+16
jmap-mailbox-create!+17
jmap-mailbox-update!+18
jmap-mailbox-destroy!)+19
+20
(begin+21
+22
;; ============================================================+23
;; Mailbox Queries+24
;; ============================================================+25
+26
;;; Get all mailboxes from the server.+27
;;;+28
;;; Returns a list of mailbox dicts, each containing fields like+29
;;; `id:`, `name:`, `role:`, `totalEmails:`, `unreadEmails:`, etc.+30
;;;+31
;;; ```scheme+32
;;; (define mailboxes (jmap-mailboxes client))+33
;;; (for-each (lambda (mb) (display (dict-ref mb name:)))+34
;;; mailboxes)+35
;;; ```+36
(define (jmap-mailboxes client)+37
(: jmap-client? -> list?)+38
(let ((result (jmap-result-ref client+39
(jmap-call "Mailbox/get"+40
(dict accountId: (jmap-client-account-id client)+41
ids: 'null)))))+42
(array->list (or (dict-ref result list: #f) #[]))))+43
+44
;;; Find a mailbox by its role.+45
;;;+46
;;; Standard JMAP roles include `"inbox"`, `"drafts"`, `"sent"`,+47
;;; `"trash"`, `"junk"`, `"archive"`. Returns the mailbox dict+48
;;; or `#f` if no mailbox has the given role.+49
;;;+50
;;; ```scheme+51
;;; (jmap-mailbox-by-role client "inbox")+52
;;; ; => #{ id: "mb1" name: "Inbox" role: "inbox" ... }+53
;;; ```+54
(define (jmap-mailbox-by-role client role)+55
(: jmap-client? string? -> (maybe dict?))+56
(let loop ((mailboxes (jmap-mailboxes client)))+57
(cond+58
((null? mailboxes) #f)+59
((equal? (dict-ref (car mailboxes) role: #f) role)+60
(car mailboxes))+61
(else (loop (cdr mailboxes))))))+62
+63
;;; Find a mailbox by its display name.+64
;;;+65
;;; Returns the first mailbox whose `name` matches, or `#f`.+66
;;;+67
;;; ```scheme+68
;;; (jmap-mailbox-by-name client "Projects")+69
;;; ; => #{ id: "mb5" name: "Projects" ... }+70
;;; ```+71
(define (jmap-mailbox-by-name client name)+72
(: jmap-client? string? -> (maybe dict?))+73
(let loop ((mailboxes (jmap-mailboxes client)))+74
(cond+75
((null? mailboxes) #f)+76
((equal? (dict-ref (car mailboxes) name: #f) name)+77
(car mailboxes))+78
(else (loop (cdr mailboxes))))))+79
+80
+81
;; ============================================================+82
;; Mailbox Mutations+83
;; ============================================================+84
+85
;;; Create a new mailbox.+86
;;;+87
;;; Returns the server-assigned ID of the created mailbox.+88
;;;+89
;;; ```scheme+90
;;; (jmap-mailbox-create! client "Projects" parent-id: inbox-id)+91
;;; ; => "mb-new-123"+92
;;; ```+93
(define (jmap-mailbox-create! client name (keys: (parent-id #f) (role #f)))+94
(: jmap-client? string? (parent-id: (maybe string?)) (role: (maybe string?)) -> string?)+95
(let* ((create-obj (dict name: name))+96
(create-obj (if parent-id+97
(dict-set create-obj parentId: parent-id)+98
create-obj))+99
(create-obj (if role+100
(dict-set create-obj role: role)+101
create-obj))+102
(result (jmap-result-ref client+103
(jmap-call "Mailbox/set"+104
(dict accountId: (jmap-client-account-id client)+105
create: (dict c0: create-obj))))))+106
(let ((created (dict-ref result created: #{})))+107
(dict-ref (dict-ref created c0: #{}) id: #f))))+108
+109
;;; Update a mailbox's properties.+110
;;;+111
;;; The `updates` dict contains the properties to change.+112
;;;+113
;;; ```scheme+114
;;; (jmap-mailbox-update! client mailbox-id #{ name: "New Name" })+115
;;; ```+116
(define (jmap-mailbox-update! client mailbox-id updates)+117
(: jmap-client? string? dict? -> dict?)+118
(jmap-result-ref client+119
(jmap-call "Mailbox/set"+120
(dict accountId: (jmap-client-account-id client)+121
update: (dict-set #{} (string->keyword mailbox-id) updates)))))+122
+123
;;; Delete a mailbox.+124
;;;+125
;;; When `on-destroy-remove-emails:` is `#t`, emails only in this+126
;;; mailbox are also destroyed. Default is `#f`.+127
;;;+128
;;; ```scheme+129
;;; (jmap-mailbox-destroy! client mailbox-id)+130
;;; ```+131
(define (jmap-mailbox-destroy! client mailbox-id+132
(keys: (on-destroy-remove-emails #f)))+133
(: jmap-client? string? (on-destroy-remove-emails: boolean?) -> dict?)+134
(jmap-result-ref client+135
(jmap-call "Mailbox/set"+136
(dict accountId: (jmap-client-account-id client)+137
destroy: #[mailbox-id]+138
onDestroyRemoveEmails: on-destroy-remove-emails))))+139
+140
))src/sigil/jmap/send.sgladded
@@ -0,0 +1,202 @@
+1
;;; (sigil jmap send) - JMAP Email Sending+2
;;;+3
;;; Provides email composition and submission via JMAP Email/set+4
;;; and EmailSubmission/set methods (RFC 8621). Also handles+5
;;; Identity/get for sender identity discovery.+6
+7
(define-library (sigil jmap send)+8
(import (sigil core)+9
(sigil string)+10
(sigil json)+11
(sigil jmap client)+12
(sigil jmap mailbox))+13
+14
(export+15
jmap-identities+16
jmap-send!)+17
+18
(begin+19
+20
;; Capability URNs needed for email submission+21
(define %submission-capabilities+22
(list "urn:ietf:params:jmap:core"+23
"urn:ietf:params:jmap:mail"+24
"urn:ietf:params:jmap:submission"))+25
+26
+27
;; ============================================================+28
;; Identities+29
;; ============================================================+30
+31
;;; Get all sending identities for the account.+32
;;;+33
;;; Returns a list of identity dicts, each containing `id:`,+34
;;; `name:`, `email:`, `replyTo:`, etc.+35
;;;+36
;;; ```scheme+37
;;; (define ids (jmap-identities client))+38
;;; (dict-ref (car ids) email:)+39
;;; ; => "[email protected]"+40
;;; ```+41
(define (jmap-identities client)+42
(: jmap-client? -> list?)+43
(let ((result (jmap-result-ref client+44
(jmap-call "Identity/get"+45
(dict accountId: (jmap-client-account-id client)+46
ids: 'null))+47
using: %submission-capabilities)))+48
(array->list (or (dict-ref result list: #f) #[]))))+49
+50
+51
;; ============================================================+52
;; Email Sending+53
;; ============================================================+54
+55
;; Build an email address object+56
(define (make-address addr)+57
(cond+58
((string? addr)+59
(dict email: addr))+60
((dict? addr) addr)+61
(else (error "jmap-send!: invalid address" addr))))+62
+63
;; Build list of address objects+64
(define (make-address-list addrs)+65
(cond+66
((not addrs) #f)+67
((string? addrs) (list->array (list (make-address addrs))))+68
((list? addrs) (list->array (map make-address addrs)))+69
(else (error "jmap-send!: invalid address list" addrs))))+70
+71
;; Build body part for text or HTML+72
(define (make-body-value body-text part-id)+73
(dict-set #{} (string->keyword part-id)+74
(dict value: body-text)))+75
+76
;;; Send an email via JMAP.+77
;;;+78
;;; Creates a draft email and submits it in a single request using+79
;;; back-references. On success, the sent email is automatically+80
;;; moved to the Sent mailbox via `onSuccessUpdateEmail`.+81
;;;+82
;;; Keywords:+83
;;; `identity-id:` - Sending identity (required, from `jmap-identities`)+84
;;; `from:` - Sender address (string or dict)+85
;;; `to:` - Recipient(s) (string, list of strings, or list of dicts)+86
;;; `cc:` - CC recipient(s) (optional)+87
;;; `bcc:` - BCC recipient(s) (optional)+88
;;; `subject:` - Email subject line+89
;;; `text-body:` - Plain text body (optional)+90
;;; `html-body:` - HTML body (optional)+91
;;; `in-reply-to:` - Message-ID being replied to (optional)+92
;;; `references:` - Message-ID references (optional)+93
;;;+94
;;; Returns the submission result dict.+95
;;;+96
;;; ```scheme+97
;;; (jmap-send! client+98
;;; identity-id: (dict-ref (car (jmap-identities client)) id:)+99
;;; from: "[email protected]"+100
;;; to: "[email protected]"+101
;;; subject: "Hello from Sigil"+102
;;; text-body: "This is a test email.")+103
;;; ```+104
(define (jmap-send! client+105
(keys: (identity-id #f) (from #f) (to #f)+106
(cc #f) (bcc #f) (subject "")+107
(text-body #f) (html-body #f)+108
(in-reply-to #f) (references #f)))+109
(: jmap-client? (identity-id: string?) (from: (maybe (any-of string? dict?)))+110
(to: any?) (cc: any?) (bcc: any?)+111
(subject: string?) (text-body: (maybe string?)) (html-body: (maybe string?))+112
(in-reply-to: (maybe string?)) (references: (maybe list?)) -> dict?)+113
(unless identity-id+114
(error "jmap-send!: identity-id: is required"))+115
(unless to+116
(error "jmap-send!: to: is required"))+117
+118
(let* ((account-id (jmap-client-account-id client))+119
;; Build the email object+120
(email (dict mailboxIds: (dict)+121
keywords: (dict (string->keyword "$draft"): #t)))+122
(email (if from+123
(dict-set email from: (list->array (list (make-address from))))+124
email))+125
(email (dict-set email to: (make-address-list to)))+126
(email (if cc+127
(dict-set email cc: (make-address-list cc))+128
email))+129
(email (if bcc+130
(dict-set email bcc: (make-address-list bcc))+131
email))+132
(email (dict-set email subject: subject))+133
(email (if in-reply-to+134
(dict-set email inReplyTo: (list->array (list in-reply-to)))+135
email))+136
(email (if references+137
(dict-set email references: (list->array references))+138
email)))+139
+140
;; Add body parts+141
(let* ((body-values #{})+142
(text-parts '())+143
(html-parts '()))+144
+145
;; Text body+146
(when text-body+147
(set! body-values (dict-set body-values textBody0:+148
(dict value: text-body)))+149
(set! text-parts (list (dict partId: "textBody0"+150
type: "text/plain"))))+151
+152
;; HTML body+153
(when html-body+154
(set! body-values (dict-set body-values htmlBody0:+155
(dict value: html-body)))+156
(set! html-parts (list (dict partId: "htmlBody0"+157
type: "text/html"))))+158
+159
(let* ((email (dict-set email bodyValues: body-values))+160
(email (if (pair? text-parts)+161
(dict-set email textBody: (list->array text-parts))+162
email))+163
(email (if (pair? html-parts)+164
(dict-set email htmlBody: (list->array html-parts))+165
email))+166
;; Find Sent mailbox for onSuccessUpdateEmail+167
(sent-mailbox (jmap-mailbox-by-role client "sent"))+168
(sent-id (if sent-mailbox (dict-ref sent-mailbox id: #f) #f))+169
;; Build the request: Email/set create + EmailSubmission/set+170
(create-call (jmap-call "Email/set"+171
(dict accountId: account-id+172
create: (dict draft: email))+173
"c0"))+174
;; Submission with back-reference to created email+175
(submission (dict identityId: identity-id+176
emailId: "#draft"))+177
;; Move to Sent on success+178
(on-success (if sent-id+179
(dict (string->keyword "#draft"):+180
(dict mailboxIds: (dict-set #{}+181
(string->keyword sent-id) #t)+182
keywords: 'null))+183
#{}))+184
(submit-call (jmap-call "EmailSubmission/set"+185
(dict accountId: account-id+186
create: (dict s0: submission)+187
onSuccessUpdateEmail: on-success)+188
"s0"))+189
(response (jmap-request client create-call submit-call+190
using: %submission-capabilities)))+191
+192
;; Check for errors+193
(when (jmap-response-error? response "c0")+194
(error "jmap-send!: email creation failed"+195
(jmap-error-type response "c0")))+196
(when (jmap-response-error? response "s0")+197
(error "jmap-send!: submission failed"+198
(jmap-error-type response "s0")))+199
+200
(jmap-response-get response "s0")))))+201
+202
))test/test-jmap.sgladded
@@ -0,0 +1,273 @@
+1
;;; Tests for JMAP client library (offline, no live server needed)+2
+3
(import (sigil test)+4
(sigil json)+5
(sigil jmap client))+6
+7
;; ============================================================+8
;; jmap-call+9
;; ============================================================+10
+11
(test-group "jmap-call"+12
+13
(test "builds method call triple with default call-id"+14
(let ((call (jmap-call "Mailbox/get" #{ accountId: "abc" ids: 'null })))+15
(assert-true (array? call))+16
(assert-equal 3 (array-length call))+17
(assert-equal "Mailbox/get" (array-ref call 0))+18
(assert-equal "abc" (dict-ref (array-ref call 1) accountId:))+19
(assert-equal "0" (array-ref call 2))))+20
+21
(test "builds method call triple with custom call-id"+22
(let ((call (jmap-call "Email/query" #{ accountId: "abc" } "q0")))+23
(assert-equal "Email/query" (array-ref call 0))+24
(assert-equal "q0" (array-ref call 2))))+25
+26
(test "preserves null values in args"+27
(let ((call (jmap-call "Mailbox/get" #{ ids: 'null })))+28
(assert-equal 'null (dict-ref (array-ref call 1) ids:)))))+29
+30
+31
;; ============================================================+32
;; jmap-response-get+33
;; ============================================================+34
+35
(test-group "jmap-response-get"+36
+37
(test "extracts result by call-id"+38
(let ((response (dict+39
methodResponses: #[+40
#["Mailbox/get" #{ accountId: "abc" list: #[] state: "s1" } "0"]])))+41
(let ((result (jmap-response-get response "0")))+42
(assert-true (dict? result))+43
(assert-equal "abc" (dict-ref result accountId:))+44
(assert-equal "s1" (dict-ref result state:)))))+45
+46
(test "returns #f for unknown call-id"+47
(let ((response (dict+48
methodResponses: #[+49
#["Mailbox/get" #{ state: "s1" } "0"]])))+50
(assert-false (jmap-response-get response "999"))))+51
+52
(test "finds correct result among multiple responses"+53
(let ((response (dict+54
methodResponses: #[+55
#["Email/query" #{ ids: #["id1" "id2"] } "q0"]+56
#["Email/get" #{ list: #[] } "g0"]])))+57
(let ((query-result (jmap-response-get response "q0"))+58
(get-result (jmap-response-get response "g0")))+59
(assert-true (dict? query-result))+60
(assert-true (dict-ref query-result ids:))+61
(assert-true (dict? get-result))+62
(assert-true (dict-ref get-result list:)))))+63
+64
(test "returns #f when methodResponses is missing"+65
(assert-false (jmap-response-get #{} "0"))))+66
+67
+68
;; ============================================================+69
;; jmap-response-error?+70
;; ============================================================+71
+72
(test-group "jmap-response-error?"+73
+74
(test "detects error response"+75
(let ((response (dict+76
methodResponses: #[+77
#["error" #{ type: "unknownMethod" } "0"]])))+78
(assert-true (jmap-response-error? response "0"))))+79
+80
(test "returns #f for success response"+81
(let ((response (dict+82
methodResponses: #[+83
#["Mailbox/get" #{ list: #[] } "0"]])))+84
(assert-false (jmap-response-error? response "0"))))+85
+86
(test "returns #f for unknown call-id"+87
(let ((response (dict+88
methodResponses: #[+89
#["error" #{ type: "unknownMethod" } "0"]])))+90
(assert-false (jmap-response-error? response "999")))))+91
+92
+93
;; ============================================================+94
;; jmap-error-type+95
;; ============================================================+96
+97
(test-group "jmap-error-type"+98
+99
(test "extracts error type string"+100
(let ((response (dict+101
methodResponses: #[+102
#["error" #{ type: "unknownMethod" } "0"]])))+103
(assert-equal "unknownMethod" (jmap-error-type response "0"))))+104
+105
(test "returns #f for non-error response"+106
(let ((response (dict+107
methodResponses: #[+108
#["Mailbox/get" #{ list: #[] } "0"]])))+109
(assert-false (jmap-error-type response "0"))))+110
+111
(test "handles various error types"+112
(let ((response (dict+113
methodResponses: #[+114
#["error" #{ type: "accountNotFound" } "0"]])))+115
(assert-equal "accountNotFound" (jmap-error-type response "0")))))+116
+117
+118
;; ============================================================+119
;; Request body JSON round-trip+120
;; ============================================================+121
+122
(test-group "request JSON structure"+123
+124
(test "method call encodes to valid JSON"+125
(let* ((call (jmap-call "Mailbox/get"+126
#{ accountId: "abc123" ids: 'null }))+127
(encoded (json-encode call))+128
(decoded (json-decode encoded)))+129
(assert-true (array? decoded))+130
(assert-equal "Mailbox/get" (array-ref decoded 0))+131
(assert-equal "abc123" (dict-ref (array-ref decoded 1) accountId:))+132
;; null encodes/decodes correctly+133
(assert-equal 'null (dict-ref (array-ref decoded 1) ids:))+134
(assert-equal "0" (array-ref decoded 2))))+135
+136
(test "request body with using and methodCalls encodes correctly"+137
(let* ((body (dict+138
using: #["urn:ietf:params:jmap:core"+139
"urn:ietf:params:jmap:mail"]+140
methodCalls: #[+141
#["Mailbox/get"+142
#{ accountId: "abc" ids: 'null }+143
"0"]]))+144
(encoded (json-encode body))+145
(decoded (json-decode encoded)))+146
(assert-true (dict? decoded))+147
;; Check using array+148
(let ((using (dict-ref decoded using:)))+149
(assert-equal 2 (array-length using))+150
(assert-equal "urn:ietf:params:jmap:core" (array-ref using 0)))+151
;; Check methodCalls+152
(let ((calls (dict-ref decoded methodCalls:)))+153
(assert-equal 1 (array-length calls))+154
(assert-equal "Mailbox/get" (array-ref (array-ref calls 0) 0))))))+155
+156
+157
;; ============================================================+158
;; Session data extraction+159
;; ============================================================+160
+161
(test-group "session data parsing"+162
+163
(test "primaryAccounts URN key lookup"+164
(let ((session (dict+165
primaryAccounts:+166
(dict-set (dict-set #{}+167
(string->keyword "urn:ietf:params:jmap:mail") "account-id-123")+168
(string->keyword "urn:ietf:params:jmap:core") "account-id-123"))))+169
(let ((primary (dict-ref session primaryAccounts: #{})))+170
(assert-equal "account-id-123"+171
(dict-ref primary+172
(string->keyword "urn:ietf:params:jmap:mail") #f)))))+173
+174
(test "capabilities with URN keys"+175
(let ((session (dict+176
capabilities:+177
(dict-set (dict-set #{}+178
(string->keyword "urn:ietf:params:jmap:core") #{ maxSizeUpload: 50000000 })+179
(string->keyword "urn:ietf:params:jmap:mail") #{}))))+180
(let ((caps (dict-ref session capabilities: #{})))+181
(assert-true+182
(dict-ref caps (string->keyword "urn:ietf:params:jmap:core") #f))+183
(assert-equal 50000000+184
(dict-ref+185
(dict-ref caps (string->keyword "urn:ietf:params:jmap:core"))+186
maxSizeUpload:))))))+187
+188
+189
;; ============================================================+190
;; Mailbox list parsing and filtering+191
;; ============================================================+192
+193
(test-group "mailbox parsing"+194
+195
(test "mailbox list from get response"+196
(let* ((response (dict+197
methodResponses: #[+198
#["Mailbox/get"+199
#{ accountId: "abc"+200
state: "s1"+201
list: #[+202
#{ id: "mb1" name: "Inbox" role: "inbox"+203
totalEmails: 42 unreadEmails: 3 }+204
#{ id: "mb2" name: "Sent" role: "sent"+205
totalEmails: 100 unreadEmails: 0 }+206
#{ id: "mb3" name: "Projects" role: #f+207
totalEmails: 10 unreadEmails: 1 }] }+208
"0"]]))+209
(result (jmap-response-get response "0"))+210
(mailboxes (array->list (dict-ref result list:))))+211
(assert-equal 3 (length mailboxes))+212
(assert-equal "Inbox" (dict-ref (car mailboxes) name:))+213
(assert-equal "inbox" (dict-ref (car mailboxes) role:))))+214
+215
(test "filter mailboxes by role"+216
(let ((mailboxes (list+217
#{ id: "mb1" name: "Inbox" role: "inbox" }+218
#{ id: "mb2" name: "Sent" role: "sent" }+219
#{ id: "mb3" name: "Trash" role: "trash" }+220
#{ id: "mb4" name: "Projects" role: #f })))+221
;; Find inbox+222
(let ((inbox (let loop ((mbs mailboxes))+223
(cond+224
((null? mbs) #f)+225
((equal? (dict-ref (car mbs) role:) "inbox") (car mbs))+226
(else (loop (cdr mbs)))))))+227
(assert-true inbox)+228
(assert-equal "mb1" (dict-ref inbox id:)))+229
;; Find by name+230
(let ((projects (let loop ((mbs mailboxes))+231
(cond+232
((null? mbs) #f)+233
((equal? (dict-ref (car mbs) name:) "Projects") (car mbs))+234
(else (loop (cdr mbs)))))))+235
(assert-true projects)+236
(assert-equal "mb4" (dict-ref projects id:))))))+237
+238
+239
;; ============================================================+240
;; Email query back-reference key+241
;; ============================================================+242
+243
(test-group "back-reference keys"+244
+245
(test "#ids key construction for Email/get back-reference"+246
(let ((get-args (dict-set (dict accountId: "abc"+247
properties: #["id" "subject" "from"])+248
(string->keyword "#ids")+249
(dict resultOf: "q0"+250
name: "Email/query"+251
path: "/ids"))))+252
;; Verify the #ids key exists and has correct structure+253
(let ((ref (dict-ref get-args (string->keyword "#ids"))))+254
(assert-true (dict? ref))+255
(assert-equal "q0" (dict-ref ref resultOf:))+256
(assert-equal "Email/query" (dict-ref ref name:))+257
(assert-equal "/ids" (dict-ref ref path:)))))+258
+259
(test "#ids key survives JSON round-trip"+260
(let* ((args (dict-set #{}+261
(string->keyword "#ids")+262
(dict resultOf: "q0"+263
name: "Email/query"+264
path: "/ids")))+265
(encoded (json-encode args))+266
(decoded (json-decode encoded)))+267
;; After decode, #ids becomes a keyword key+268
(let ((ref (dict-ref decoded (string->keyword "#ids") #f)))+269
(assert-true (dict? ref))+270
(assert-equal "q0" (dict-ref ref resultOf:))))))+271
+272
+273
(run-tests)