src/sigil/jmap/client.sgl

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.

7(define-library (sigil jmap client)

8 (import (sigil core)

9 (sigil string)

10 (sigil struct)

11 (sigil http client))

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

27 ;; Connection

28 jmap-connect

30 ;; Request building

31 jmap-call

32 jmap-request

33 jmap-result-ref

35 ;; Response helpers

36 jmap-response-get

37 jmap-response-error?

38 jmap-error-type

40 ;; Blob download

41 jmap-download-blob)

43 (begin

45 ;; ============================================================

46 ;; Client Record

47 ;; ============================================================

49 (define-struct jmap-client

50 (session-url string?)

51 (auth-header string?)

52 (api-url default: #f mutable: #t)

53 (download-url default: #f mutable: #t)

54 (upload-url default: #f mutable: #t)

55 (account-id default: #f mutable: #t)

56 (accounts default: #{} mutable: #t)

57 (capabilities default: #{} mutable: #t)

58 (session-state default: #f mutable: #t))

61 ;; ============================================================

62 ;; Session Discovery

63 ;; ============================================================

65 ;;; Connect to a JMAP server and discover session capabilities.

66 ;;;

67 ;;; Fetches the JMAP session resource, populates the client with

68 ;;; API URLs, account IDs, and capabilities. Authenticates using

69 ;;; either a Bearer token or a pre-built Authorization header.

70 ;;;

71 ;;; ```scheme

72 ;;; (jmap-connect

73 ;;; url: "https://api.fastmail.com/.well-known/jmap"

74 ;;; token: "fmu1-...")

75 ;;;

76 ;;; (jmap-connect

77 ;;; url: "https://jmap.example.com/.well-known/jmap"

78 ;;; auth: "Basic dXNlcjpwYXNz")

79 ;;; ```

80 (define (jmap-connect (keys: (url #f) (token #f) (auth #f)))

81 (: (url: string?) (token: any?) (auth: any?) -> jmap-client?)

82 (unless url

83 (error "jmap-connect: url: is required"))

84 (unless (or token auth)

85 (error "jmap-connect: token: or auth: is required"))

87 (let* ((auth-header (if token

88 (string-append "Bearer " token)

89 auth))

90 (client (jmap-client

91 session-url: url

92 auth-header: auth-header))

93 (session (http-get/json url

94 headers: (dict authorization: auth-header))))

95 (unless session

96 (error "jmap-connect: failed to fetch session resource" url))

98 ;; Populate client from session

99 (set-jmap-client-api-url! client (dict-ref session apiUrl: #f))

100 (set-jmap-client-download-url! client (dict-ref session downloadUrl: #f))

101 (set-jmap-client-upload-url! client (dict-ref session uploadUrl: #f))

102 (set-jmap-client-session-state! client (dict-ref session state: #f))

103 (set-jmap-client-capabilities! client (or (dict-ref session capabilities: #f) #{}))

104 (set-jmap-client-accounts! client (or (dict-ref session accounts: #f) #{}))

105

106 ;; Find primary mail account

107 (let ((primary-accounts (dict-ref session primaryAccounts: #{})))

108 (let ((mail-account-id (dict-ref primary-accounts

109 (string->keyword "urn:ietf:params:jmap:mail")

110 #f)))

111 (when mail-account-id

112 (set-jmap-client-account-id! client mail-account-id))))

113

114 client))

115

116

117 ;; ============================================================

118 ;; Request Building

119 ;; ============================================================

120

121 ;;; Build a JMAP method call triple.

122 ;;;

123 ;;; Returns an array of `[method-name, arguments, call-id]` suitable

124 ;;; for inclusion in the `methodCalls` array of a JMAP request.

125 ;;;

126 ;;; ```scheme

127 ;;; (jmap-call "Mailbox/get"

128 ;;; #{ accountId: "abc123" ids: 'null })

129 ;;; ; => #["Mailbox/get" #{ accountId: "abc123" ids: null } "0"]

130 ;;;

131 ;;; (jmap-call "Email/query"

132 ;;; #{ accountId: "abc123" }

133 ;;; "q0")

134 ;;; ; => #["Email/query" #{ accountId: "abc123" } "q0"]

135 ;;; ```

136 (define (jmap-call method args . call-id)

137 (: string? dict? string? ... -> array?)

138 (list->array (list method args (if (pair? call-id) (car call-id) "0"))))

139

140 ;;; Send JMAP method calls to the server.

141 ;;;

142 ;;; Takes the client and one or more method call triples (from `jmap-call`).

143 ;;; Returns the parsed JSON response body, or raises an error on

144 ;;; HTTP failure.

145 ;;;

146 ;;; The `using:` keyword specifies JMAP capability URNs to include.

147 ;;; Defaults to core and mail capabilities.

148 ;;;

149 ;;; ```scheme

150 ;;; (jmap-request client

151 ;;; (jmap-call "Mailbox/get" #{ accountId: id ids: 'null }))

152 ;;; ```

153 (define (jmap-request client (rest: calls) (keys: (using #f)))

154 (: jmap-client? array? ... (using: any?) -> dict?)

155 (let* ((capability-urns (or using

156 (list "urn:ietf:params:jmap:core"

157 "urn:ietf:params:jmap:mail")))

158 (body (dict

159 using: (list->array capability-urns)

160 methodCalls: (list->array calls)))

161 (result (http-post/json

162 (jmap-client-api-url client)

163 body

164 headers: (dict

165 authorization: (jmap-client-auth-header client)))))

166 (unless result

167 (error "jmap-request: HTTP request failed"))

168

169 ;; Update session state if changed

170 (let ((new-state (dict-ref result sessionState: #f)))

171 (when (and new-state

172 (not (equal? new-state (jmap-client-session-state client))))

173 (set-jmap-client-session-state! client new-state)))

174

175 result))

176

177

178 ;; ============================================================

179 ;; Response Helpers

180 ;; ============================================================

181

182 ;;; Extract a method response by call ID from a JMAP response.

183 ;;;

184 ;;; Searches the `methodResponses` array for a triple matching the

185 ;;; given call ID and returns its arguments dict. Returns `#f` if

186 ;;; no match is found.

187 ;;;

188 ;;; ```scheme

189 ;;; (jmap-response-get response "0")

190 ;;; ; => #{ accountId: "abc" state: "..." list: #[...] }

191 ;;; ```

192 (define (jmap-response-get response call-id)

193 (: dict? string? -> any?)

194 (let ((responses (dict-ref response methodResponses: #f)))

195 (and responses

196 (let loop ((i 0))

197 (if (>= i (array-length responses))

198 #f

199 (let ((triple (array-ref responses i)))

200 (if (equal? (array-ref triple 2) call-id)

201 (array-ref triple 1)

202 (loop (+ i 1)))))))))

203

204 ;;; Check if a method response is a JMAP error.

205 ;;;

206 ;;; Returns `#t` if the response triple for the given call ID has

207 ;;; `"error"` as its method name.

208 ;;;

209 ;;; ```scheme

210 ;;; (jmap-response-error? response "0")

211 ;;; ; => #f

212 ;;; ```

213 (define (jmap-response-error? response call-id)

214 (: dict? string? -> boolean?)

215 (let ((responses (dict-ref response methodResponses: #f)))

216 (and responses

217 (let loop ((i 0))

218 (if (>= i (array-length responses))

219 #f

220 (let ((triple (array-ref responses i)))

221 (if (equal? (array-ref triple 2) call-id)

222 (equal? (array-ref triple 0) "error")

223 (loop (+ i 1)))))))))

224

225 ;;; Get the error type from a JMAP error response.

226 ;;;

227 ;;; Returns the `type` field from the error arguments, or `#f` if

228 ;;; the response is not an error.

229 ;;;

230 ;;; ```scheme

231 ;;; (jmap-error-type response "0")

232 ;;; ; => "unknownMethod"

233 ;;; ```

234 (define (jmap-error-type response call-id)

235 (: dict? string? -> any?)

236 (let ((responses (dict-ref response methodResponses: #f)))

237 (and responses

238 (let loop ((i 0))

239 (if (>= i (array-length responses))

240 #f

241 (let ((triple (array-ref responses i)))

242 (if (and (equal? (array-ref triple 2) call-id)

243 (equal? (array-ref triple 0) "error"))

244 (dict-ref (array-ref triple 1) type: #f)

245 (loop (+ i 1)))))))))

246

247 ;;; Send a single JMAP method call and return the result directly.

248 ;;;

249 ;;; Convenience wrapper around `jmap-request` + `jmap-response-get`.

250 ;;; Raises an error if the response is a JMAP-level error.

251 ;;;

252 ;;; ```scheme

253 ;;; (jmap-result-ref client

254 ;;; (jmap-call "Mailbox/get" #{ accountId: id ids: 'null }))

255 ;;; ; => #{ accountId: "abc" state: "..." list: #[...] }

256 ;;; ```

257 (define (jmap-result-ref client call (keys: (using #f)))

258 (: jmap-client? array? (using: any?) -> dict?)

259 (let* ((call-id (array-ref call 2))

260 (response (if using

261 (jmap-request client call using: using)

262 (jmap-request client call))))

263 (when (jmap-response-error? response call-id)

264 (let ((err-type (jmap-error-type response call-id)))

265 (error (string-append "JMAP error: " (or err-type "unknown"))

266 (jmap-response-get response call-id))))

267 (jmap-response-get response call-id)))

268

269

270 ;; ============================================================

271 ;; Blob Download

272 ;; ============================================================

273

274 ;;; Download a JMAP blob to a file.

275 ;;;

276 ;;; Expands the server's download URL template (RFC 8620 section 6.2)

277 ;;; and streams the blob to `dest-path` using the client's auth.

278 ;;;

279 ;;; Returns a dict with download info on success:

280 ;;; `#{ status: 200 size: 12345 path: "/tmp/file.pdf" }`

281 ;;;

282 ;;; ```scheme

283 ;;; (jmap-download-blob client "Bf12abc" "report.pdf"

284 ;;; "application/pdf" "/tmp/report.pdf")

285 ;;; ```

286 (define (jmap-download-blob client blob-id name type dest-path)

287 (: jmap-client? string? string? string? string? -> dict?)

288 (let* ((template (or (jmap-client-download-url client)

289 (error "jmap-download-blob: no download URL in session")))

290 (account-id (or (jmap-client-account-id client)

291 (error "jmap-download-blob: no account ID")))

292 (url (string-replace

293 (string-replace

294 (string-replace

295 (string-replace template

296 "{accountId}" account-id)

297 "{blobId}" blob-id)

298 "{name}" name)

299 "{type}" type))

300 (result (http-download url dest-path

301 headers: (dict

302 authorization: (jmap-client-auth-header client)))))

303 (unless result

304 (error "jmap-download-blob: download failed" url))

305 result))

306

307 ))