Fix bytevector->hex-string.
[guile-toxcore.git] / tox.scm
1 ;;; guile-toxcore
2 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
3 ;;;
4 ;;; guile-toxcore is free software: you can redistribute it and/or modify it
5 ;;; under the terms of the GNU General Public License as published by the Free
6 ;;; Software Foundation, either version 3 of the License, or (at your option)
7 ;;; any later version.
8 ;;;
9 ;;; guile-toxcore is distributed in the hope that it will be useful, but
10 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 ;;; for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 ;;; Commentary:
19 ;;
20 ;; Tox API.
21 ;;
22 ;;; Code:
23
24 (define-module (tox)
25 #:use-module (ice-9 format)
26 #:use-module (rnrs bytevectors)
27 #:use-module (srfi srfi-4)
28 #:use-module (srfi srfi-9)
29 #:use-module (system foreign)
30 #:use-module ((tox bindings) #:prefix %)
31 #:use-module (tox util)
32 #:export (tox-friend-add-error
33 tox-user-status
34 tox-max-name-length tox-max-message-length
35 tox-max-status-message-length
36 tox-client-id-size tox-friend-address-size
37 tox-client-id tox-friend-address
38 make-tox tox-kill with-tox
39 tox-friend-request-hook tox-message-hook tox-action-hook
40 tox-name-change-hook tox-status-message-hook tox-status-hook
41 tox-typing-hook tox-read-receipt-hook tox-connection-status-hook
42 tox? tox-connected?
43 tox-do-interval tox-do
44 tox-size tox-save tox-load! tox-load
45 tox-bootstrap-from-address
46 tox-address
47 tox-add-friend tox-add-friend-no-request tox-delete-friend
48 tox-friend-number tox-friend-client-id
49 tox-friend-connected? tox-friend-exists?
50 tox-send-message tox-send-action
51 set-tox-name tox-name tox-friend-name
52 set-tox-status set-tox-status-message
53 tox-status-message tox-friend-status-message
54 tox-status tox-friend-status
55 tox-friend-last-online
56 set-tox-friend-typing tox-friend-typing?
57 set-tox-send-receipts
58 tox-friend-count tox-online-friend-count
59 tox-friend-list))
60
61 (define-enumeration tox-friend-add-error
62 (too-long -1)
63 (no-message -2)
64 (own-key -3)
65 (already-sent -4)
66 (unknown -5)
67 (bad-checksum -6)
68 (set-new-no-spam -7)
69 (no-mem -8))
70
71 (define-enumeration tox-user-status
72 (none 0)
73 (away 1)
74 (busy 2)
75 (invalid 3))
76
77 (define tox-max-name-length 128)
78 (define tox-max-message-length 1368)
79 (define tox-max-status-message-length 1007)
80 (define tox-client-id-size 32)
81 (define tox-friend-address-size
82 (+ tox-client-id-size (sizeof uint32) (sizeof uint16)))
83
84 (define (tox-client-id id)
85 "Return a newly allocated bytevector of length tox-client-id-size by
86 transcoding the hexadecimal string ID."
87 (if (= (string-length id) (* tox-client-id-size 2))
88 (hex-string->bytevector id)
89 (error "Invalid Tox client ID: " id)))
90
91 (define (tox-friend-address address)
92 "Return a newly allocated bytevector of length tox-friend-address-size by
93 transcoding the hexadecimal string ADDRESS."
94 (if (= (string-length address) (* tox-friend-address-size 2))
95 (hex-string->bytevector address)
96 (error "Invalid Tox friend address: " address)))
97
98 (define-record-type <tox>
99 (%make-tox pointer friend-request-hook message-hook action-hook
100 name-change-hook status-message-hook status-hook
101 typing-hook read-receipt-hook connection-status-hook)
102 tox?
103 (pointer tox-pointer)
104 (friend-request-hook tox-friend-request-hook)
105 (message-hook tox-message-hook)
106 (action-hook tox-action-hook)
107 (name-change-hook tox-name-change-hook)
108 (status-message-hook tox-status-message-hook)
109 (status-hook tox-status-hook)
110 (typing-hook tox-typing-hook)
111 (read-receipt-hook tox-read-receipt-hook)
112 (connection-status-hook tox-connection-status-hook))
113
114 (define (wrap-tox pointer)
115 (let ((tox (%make-tox pointer
116 (make-hook 3)
117 (make-hook 3)
118 (make-hook)
119 (make-hook)
120 (make-hook)
121 (make-hook)
122 (make-hook)
123 (make-hook)
124 (make-hook))))
125 ;; Register callbacks to run hooks.
126 (%tox-callback-friend-request
127 pointer
128 (procedure->pointer
129 void
130 (lambda (ptr public-key message length user-data)
131 (run-hook (tox-friend-request-hook tox)
132 tox
133 (pointer->bytevector public-key tox-client-id-size)
134 (utf8-pointer->string message length)))
135 (list '* '* '* uint16 '*))
136 %null-pointer)
137
138 (%tox-callback-friend-message
139 pointer
140 (procedure->pointer
141 void
142 (lambda (ptr friend-number message length user-data)
143 (run-hook (tox-message-hook tox)
144 tox
145 friend-number
146 (utf8-pointer->string message length)))
147 (list '* int32 '* uint16 '*))
148 %null-pointer)
149
150 tox))
151
152 (define (unwrap-tox tox)
153 (tox-pointer tox))
154
155 (define-syntax-rule (define/unwrap name docstring proc)
156 (define (name tox)
157 docstring
158 (proc (unwrap-tox tox))))
159
160 (define* (make-tox #:optional (ipv6-enabled? #t))
161 "Return a newly allocated Tox messenger. IPV6-ENABLED? indicates whether to
162 create a IPv4 or IPv6 socket. By default, an IPv6 socket is created."
163 (let ((ptr (%tox-new (boolean->number ipv6-enabled?))))
164 (if (null-pointer? ptr)
165 (error "Failed to create Tox messenger")
166 (wrap-tox ptr))))
167
168 (define/unwrap tox-kill
169 "Free all memory associated with the messenger TOX."
170 %tox-kill)
171
172 (define-syntax-rule (with-tox tox body ...)
173 "Evaluate BODY ... and ensure that memory for the messenger TOX is properly
174 freed when with-tox returns, be it normally or because of an exception."
175 (dynamic-wind
176 (lambda () #t)
177 (lambda ()
178 (let ((results (call-with-values (lambda () body ...) list)))
179 (tox-kill tox)
180 (apply values results)))
181 (lambda ()
182 (tox-kill tox))))
183
184 (define/unwrap tox-do-interval
185 "Return the time in milliseconds before tox-do should be called
186 again for optimal performance."
187 %tox-do-interval)
188
189 (define/unwrap tox-do
190 "The main loop that needs to be run in intervals of tox-do-interval
191 milliseconds."
192 %tox-do)
193
194 (define/unwrap tox-size
195 "Return the size of the Tox messenger data in bytes. Useful for
196 saving state."
197 %tox-size)
198
199 (define (tox-save tox)
200 "Return a uint8 bytevector containing the state of the messenger
201 TOX."
202 (let ((bv (make-u8vector (tox-size tox))))
203 (%tox-save (unwrap-tox tox) (bytevector->pointer bv))
204 bv))
205
206 (define (tox-load tox state)
207 "Load the saved data in the bytevector STATE into the messenger
208 TOX."
209 (or (zero?
210 (%tox-load (unwrap-tox tox)
211 (bytevector->pointer state)
212 (bytevector-length state)))
213 (error "Failed to load Tox state: " tox)))
214
215 (define (tox-connected? tox)
216 "Return #t if the messenger TOX is connected to the DHT, #f
217 otherwise."
218 (one? (%tox-isconnected (unwrap-tox tox))))
219
220 (define (tox-bootstrap-from-address tox address ipv6-enabled? port public-key)
221 "Resolve ADDRESS into an IP address. If successful, send a 'get
222 nodes' request to the given node with IP, PORT, and PUBLIC-KEY to
223 setup connections.
224
225 ADDRESS can be a hostname or an IP address (IPv4 or IPv6). If
226 IPV6-ENABLED? is #f, the resolving sticks strictly to IPv4 addresses.
227 If IPV6-ENABLED? is #t, the resolving procedure looks for IPv6
228 addresses first, then IPv4 addresses. PUBLIC-KEY is a 32 byte long
229 bytevector.
230
231 Return #t if ADDRESS could be converted into an IP address, #f
232 otherwise."
233 (one? (%tox-bootstrap-from-address
234 (unwrap-tox tox)
235 (string->pointer address)
236 (boolean->number ipv6-enabled?)
237 (htons port)
238 (bytevector->pointer public-key))))
239
240 (define (tox-address tox)
241 "Return bytevector containing the friend address for the messenger
242 TOX."
243 (let ((bv (make-bytevector tox-friend-address-size)))
244 (%tox-get-address (unwrap-tox tox) (bytevector->pointer bv))
245 bv))
246
247 (define (tox-add-friend tox address message)
248 "Add a friend identified by the bytevector ADDRESS to the messenger TOX.
249 Additionally, send a friend request containing the string MESSAGE. ADDRESS
250 must be tox-friend-address-size bytes long. Return a friend number on
251 success, otherwise return a negative number that corresponds to an error code
252 enumerated in tox-friend-add-error."
253 (let ((m (string->utf8 message)))
254 (%tox-add-friend (unwrap-tox tox)
255 (bytevector->pointer address)
256 (bytevector->pointer m)
257 (bytevector-length m))))
258
259 (define (tox-add-friend-no-request tox client-id)
260 "Add a friend identified by the bytevector CLIENT-ID to the messenger TOX
261 without sending a friend request. Return the friend number if successful, or
262 #f otherwise."
263 (false-if-negative
264 (%tox-add-friend-norequest (unwrap-tox tox)
265 (bytevector->pointer client-id))))
266
267 (define (tox-delete-friend tox friend-number)
268 "Remove the friend identified by FRIEND-NUMBER from the messenger TOX.
269 Return #t if successful, #f otherwise."
270 (zero? (%tox-del-friend (unwrap-tox tox) friend-number)))
271
272 (define (tox-friend-number tox client-id)
273 "Return the friend number associated with the bytevector CLIENT-ID in the
274 messenger TOX, or #f if no such friend exists."
275 (false-if-negative
276 (%tox-get-friend-number (unwrap-tox tox)
277 (bytevector->pointer client-id))))
278
279 (define (tox-friend-client-id tox friend-number)
280 "Return a bytevector containing the public key associated with FRIEND-NUMBER
281 in the messenger TOX, or #f if no such friend exists."
282 (let* ((bv (make-bytevector tox-client-id-size))
283 (result (%tox-get-client-id (unwrap-tox tox)
284 friend-number
285 (bytevector->pointer bv))))
286 (if (negative? result) #f bv)))
287
288 (define (tox-friend-connected? tox friend-number)
289 "Return #t if friend identified by FRIEND-NUMBER is online, #f otherwise."
290 (one? (%tox-get-friend-connection-status (unwrap-tox tox) friend-number)))
291
292 (define (tox-friend-exists? tox friend-number)
293 "Return #t if friend identified by FRIEND-NUMBER exists, #f otherwise."
294 (one? (%tox-friend-exists (unwrap-tox tox) friend-number)))
295
296 (define (tox-send tox send send-with-id friend-number message id)
297 (let* ((tox (unwrap-tox tox))
298 (message (string->utf8 message))
299 (ptr (bytevector->pointer message))
300 (length (bytevector-length message)))
301 (false-if-zero
302 (if id
303 (send-with-id tox friend-number id ptr length)
304 (send tox friend-number ptr length)))))
305
306 (define* (tox-send-message tox friend-number message #:optional (id #f))
307 "Send the string MESSAGE to the friend identified by FRIEND-NUMBER in the
308 messenger TOX. Optionally, a message ID may be given. If omitted, an id is
309 automatically generated. MESSAGE length may not exceed
310 tox-max-message-length.
311
312 Return the message id on success, #f otherwise."
313 (tox-send tox
314 %tox-send-message
315 %tox-send-message-withid
316 friend-number
317 message
318 id))
319
320 (define* (tox-send-action tox friend-number action #:optional (id #f))
321 "Send the string ACTION to the friend identified by FRIEND-NUMBER in the
322 messenger TOX. Optionally, a message ID may be given. If omitted, an id is
323 automatically generated. MESSAGE length may not exceed
324 tox-max-message-length.
325
326 Return the message id on success, #f otherwise."
327 (tox-send tox
328 %tox-send-action
329 %tox-send-action-withid
330 friend-number
331 action
332 id))
333
334 (define (set-tox-name tox name)
335 "Use the nickname NAME for the messenger TOX."
336 (let ((n (string->utf8 name)))
337 (if (zero? (%tox-set-name (unwrap-tox tox)
338 (bytevector->pointer n)
339 (bytevector-length n)))
340 *unspecified*
341 (error "Invalid nickname: " name))))
342
343 (define (tox-name tox)
344 "Return the nickname for the messenger TOX."
345 (let* ((name (make-bytevector tox-max-name-length))
346 (length (%tox-get-self-name (unwrap-tox tox)
347 (bytevector->pointer name))))
348 (if (positive? length)
349 (utf8->string (bytevector-slice name 0 length))
350 (error "Failed to get nickname"))))
351
352 (define (tox-friend-name tox friend-number)
353 "Return the nickname of the friend identified by FRIEND-NUMBER for the
354 messenger TOX."
355 (let* ((name (make-bytevector tox-max-name-length))
356 (length (%tox-get-name (unwrap-tox tox)
357 friend-number
358 (bytevector->pointer name))))
359 (if (positive? length)
360 (utf8->string (bytevector-slice name 0 length))
361 (error "Failed to get nickname for friend number: " friend-number))))
362
363 (define (set-tox-status tox status)
364 "Set the user status for the messenger TOX to STATUS."
365 (when (negative? (%tox-set-user-status (unwrap-tox tox) status))
366 (error "Invalid user status: " status)))
367
368 (define (set-tox-status-message tox message)
369 "Set the status message for the messenger TOX to the string MESSAGE."
370 (let ((m (string->utf8 message)))
371 (when (negative?
372 (%tox-set-status-message (unwrap-tox tox)
373 (bytevector->pointer m)
374 (bytevector-length m)))
375 (error "Invalid status message: " message))))
376
377 (define (tox-status-message tox)
378 "Return the status message for the messenger TOX."
379 (let* ((message (make-bytevector tox-max-status-message-length))
380 (length (%tox-get-self-status-message (unwrap-tox tox)
381 (bytevector->pointer message)
382 tox-max-status-message-length)))
383 (if (positive? length)
384 (utf8->string (bytevector-slice message 0 length))
385 (error "Failed to get status message"))))
386
387 (define (tox-friend-status-message tox friend-number)
388 "Return the status message for the friend identified by FRIEND-NUMBER i the
389 messenger TOX."
390 (let* ((message (make-bytevector tox-max-status-message-length))
391 (length (%tox-get-status-message (unwrap-tox tox)
392 friend-number
393 (bytevector->pointer message)
394 tox-max-status-message-length)))
395 (if (positive? length)
396 (utf8->string (bytevector-slice message 0 length))
397 (error "Failed to get status message for friend number: "
398 friend-number))))
399
400 (define/unwrap tox-status
401 "Return the user status code for the messenger TOX."
402 %tox-get-self-user-status)
403
404 (define (tox-friend-status tox friend-number)
405 "Return the user status code for the friend identified by FRIEND-NUMBER in
406 the messenger TOX."
407 (%tox-get-user-status (unwrap-tox tox) friend-number))
408
409 (define (tox-friend-last-online tox friend-number)
410 "Return the timestamp of the last time the friend identified by
411 FRIEND-NUMBER was seen online, or 0 if never seen."
412 (let ((result (%tox-get-last-online (unwrap-tox tox) friend-number)))
413 (if (negative? result)
414 (error "Invalid friend number: " friend-number)
415 result)))
416
417 (define (set-tox-friend-typing tox friend-number typing?)
418 "Set the typing flag for the friend identified by FRIEND-NUMBER in the
419 messenger TOX."
420 (if (zero? (%tox-set-user-is-typing (unwrap-tox tox) friend-number typing?))
421 *unspecified*
422 (error "Invalid friend number: " friend-number)))
423
424 (define (tox-friend-typing? tox friend-number)
425 "Return #t if the friend identified by FRIEND-NUMBER in the messenger TOX is
426 typing, or #f otherwise."
427 (one? (%tox-get-is-typing (unwrap-tox tox) friend-number)))
428
429 (define (set-tox-send-receipts tox friend-number send-receipts?)
430 "Set whether to send receipts to the friend identified by FRIEND-NUMBER in
431 the messenger TOX. SEND-RECEIPTS? should be either #t of #f."
432 (%tox-set-sends-receipts (unwrap-tox tox)
433 friend-number
434 (boolean->number send-receipts?)))
435
436 (define/unwrap tox-friend-count
437 "Return the number of friends in the friend list for the messenger TOX."
438 %tox-count-friendlist)
439
440 (define/unwrap tox-online-friend-count
441 "Return the number of online friends in the friend list for the messenger
442 TOX."
443 %tox-get-num-online-friends)
444
445 (define (tox-friend-list tox)
446 "Return a list of all friend numbers for the messenger TOX."
447 (let* ((length (tox-friend-count tox))
448 (bv (make-s32vector length)))
449 (%tox-get-friendlist (unwrap-tox tox)
450 (bytevector->pointer bv)
451 length)
452 (bytevector->sint-list bv (native-endianness) (sizeof int32))))