summaryrefslogtreecommitdiff
path: root/qkbox/toot.scm
diff options
context:
space:
mode:
authorMasaya Tojo <masaya@tojo.tokyo>2020-07-08 09:49:36 +0900
committerMasaya Tojo <masaya@tojo.tokyo>2020-07-08 09:54:12 +0900
commit1704f7b6de3d79919bffa7739f4cb51a5f46bd33 (patch)
tree8c4c2f04478b056064584cc6efad70df15a4fe21 /qkbox/toot.scm
parent4c3d288c1c6889c5c62bf26c6c68ee646f0fd2a6 (diff)
qkbox: toot: Update post procedure.
Diffstat (limited to 'qkbox/toot.scm')
-rw-r--r--qkbox/toot.scm89
1 files changed, 78 insertions, 11 deletions
diff --git a/qkbox/toot.scm b/qkbox/toot.scm
index 94de0ad..d52314d 100644
--- a/qkbox/toot.scm
+++ b/qkbox/toot.scm
@@ -1,15 +1,82 @@
(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))
-(define* (post x #:key spoiler-text)
- (apply system*
- "toot"
- "post"
- (cond
- ((string? x) x)
- (else
- (format #f "~y" x)))
- `(,@(if spoiler-text
- `("-p" ,spoiler-text)
- '()))))
+(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)
+ (post-json
+ "/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))))
+ '()))))
+
+(define (post-json path json)
+ (define-values (res body)
+ (http-post (string-append "https://"
+ (current-mastodon-host)
+ path)
+ #:headers `((content-type application/json)
+ (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)))