89 lines
3.7 KiB
Racket
89 lines
3.7 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
racket/string
|
|
racket/file
|
|
srfi/8
|
|
net/url
|
|
net/uri-codec
|
|
json)
|
|
|
|
(provide mastodon-client%)
|
|
|
|
; Mastodon client class
|
|
; Only Bearer Authorization is supported
|
|
(define mastodon-client%
|
|
(class object%
|
|
(init instance authorization-bearer)
|
|
(super-new)
|
|
; Instance to connect to
|
|
(define mastodon-instance instance)
|
|
; Authorization bearer to use
|
|
(define mastodon-authorization-bearer authorization-bearer)
|
|
; Methods
|
|
; Post a new status
|
|
; status: the message to post
|
|
; visibility: #f if using the default visibility, or one of "public" "unlisted" "private" "direct"
|
|
; in-reply-to-id: #f if not replying, or the numeric id of the post to reply to
|
|
; spoiler-text: #f if not set, or the text to be shown as a warning before the actual content
|
|
; media-ids: #f if not set, or a list of identifiers for media attachments
|
|
; TODO: media_ids + sensitive
|
|
; Return a dictionnary corresponding to the json structure returned by the server
|
|
(define/public (new-status status
|
|
#:visibility [visibility #f]
|
|
#:in-reply-to-id [in-reply-to-id #f]
|
|
#:spoiler-text [spoiler-text #f]
|
|
#:media-ids [media-ids #f])
|
|
(read-json
|
|
(post-pure-port
|
|
(string->url (string-append mastodon-instance "/api/v1/statuses"))
|
|
(string->bytes/utf-8
|
|
(string-append
|
|
"status=" (uri-encode status)
|
|
(if visibility
|
|
(string-append "&visibility=" visibility)
|
|
"")
|
|
(if in-reply-to-id
|
|
(string-append "&in_reply_to_id=" (if (string? in-reply-to-id) in-reply-to-id (number->string in-reply-to-id)))
|
|
"")
|
|
(if spoiler-text
|
|
(string-append "&spoiler_text=" (uri-encode spoiler-text))
|
|
"")
|
|
(if media-ids
|
|
(string-join
|
|
(map (lambda (x) (string-append "&media_ids[]=" (if (string? x) x (number->string x)))) media-ids)
|
|
"")
|
|
"")
|
|
))
|
|
(list
|
|
"Content-Type: application/x-www-form-urlencoded"
|
|
(string-append "Authorization: Bearer " mastodon-authorization-bearer))
|
|
)))
|
|
; Upload a media
|
|
; file: path of the file to upload
|
|
; content-type: type of content, as a string
|
|
(define/public (upload-media filepath content-type)
|
|
(let ((boundary (string-append "----rkt" (number->string (current-seconds))))
|
|
(endline "\r\n")
|
|
(path (string->path filepath))
|
|
)
|
|
(read-json
|
|
(post-pure-port
|
|
(string->url (string-append mastodon-instance "/api/v1/media"))
|
|
(bytes-append
|
|
(string->bytes/utf-8 (string-append "--" boundary endline))
|
|
(receive
|
|
(basepath filename dir?) (split-path path)
|
|
(string->bytes/utf-8 (string-append "Content-Disposition: form-data; name=\"file\"; filename=\"" (path->string filename) "\"" endline)))
|
|
(string->bytes/utf-8 (string-append "Content-Type: " content-type endline))
|
|
(string->bytes/utf-8 (string-append "Content-Transfer-Encoding: binary" endline))
|
|
(string->bytes/utf-8 endline)
|
|
(file->bytes path)
|
|
(string->bytes/utf-8 (string-append "--" boundary "--"))
|
|
)
|
|
(list
|
|
(string-append "Content-Type: multipart/form-data; boundary=" boundary)
|
|
(string-append "Authorization: Bearer " mastodon-authorization-bearer))
|
|
))))
|
|
))
|