1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(define-module (qkbox toot)
#:use-module (ice-9 format)
#:use-module (web response)
#:use-module (web client)
#:use-module (json builder)
#:use-module (json parser)
#:use-module (rnrs bytevectors)
#:export (post timeline))
(define current-mastodon-host
(make-parameter (getenv "MASTODON_HOST")))
(define current-mastodon-access-token
(make-parameter (getenv "MASTODON_ACCESS_TOKEN")))
(define* (post status
#:key
spoiler-text
visibility
sensitive?
reply-to)
(define-values (res body)
(/api/v1/statuses #:status status
#:spoiler-text spoiler-text
#:visibility visibility
#:sensitive? sensitive?
#:reply-to reply-to))
(case (response-code res)
((200)
(assoc-ref body "id"))
(else
(error "post: failed" res body))))
(define* (/api/v1/statuses #:key
status
spoiler-text
visibility
sensitive?
reply-to
media-ids)
(request
'POST
"/api/v1/statuses"
`(,@(if status
`((status . ,(if (string? status)
status
(format #f "~y" status))))
'())
,@(if spoiler-text
`((spoiler_text . ,spoiler-text))
'())
,@(if visibility
(case visibility
((public unlisted private direct)
`((visibility . ,visibility)))
(else
(error "post: invalid visibility (must be one of: public unlisted private direct)")))
'())
,@(if sensitive? `((sensitive . (if sensitive? #t #f)))
'())
,@(if reply-to
`((in_reply_to_id . ,reply-to))
'())
,@(if media-ids
`((media_ids . ,(list->vector (map number->string media-ids))))
'()))
#:authorization? #t))
(define* (timeline #:key max-id since-id min-id limit local?)
(define-values (res body)
(/api/v1/timelines/home #:max-id max-id
#:since-id since-id
#:min-id min-id
#:limit limit
#:local? local?))
(case (response-code res)
((200)
(map (lambda (status)
`((id . ,(assoc-ref status "id"))
(name . ,(assoc-ref (assoc-ref status "account")
"display_name"))
(url . ,(assoc-ref status "url"))
(content . ,(assoc-ref status "content"))))
(vector->list body)))
((206)
(error "timeline: Home feed is regenerating"))
(else
(error "timeline: failed" res body))))
(define* (/api/v1/timelines/home #:key max-id since-id min-id limit local?)
(request
'GET
"/api/v1/timelines/home"
`(,@(if max-id `((max-id . ,max-id)) '())
,@(if since-id `((since-id . ,since-id)) '())
,@(if min-id `((min-id . ,min-id)) '())
,@(if limit `((limit . ,limit)) '())
,@(if local? `((local . ,local?)) '()))
#:authorization? #t))
(define* (request method path json #:key authorization?)
(define-values (res body)
(http-request (string-append "https://"
(current-mastodon-host)
path)
#:method method
#:headers `((content-type application/json)
,@(if authorization?
`((authorization
,(string->symbol
(string-append
"Bearer "
(current-mastodon-access-token)))))
'()))
#:decode-body? #t
#:body (scm->json-string json)))
(if (= 200 (response-code res))
(values res (json-string->scm (utf8->string body)))
(values res body)))
|
