Add postbot and systemd files.
This commit is contained in:
Feufochmar
parent
0f289111e4
commit
f5703ee927
|
|
@ -0,0 +1,19 @@
|
|||
#lang racket/base
|
||||
|
||||
; Configuration parameters for bots
|
||||
(provide
|
||||
feuforeve:website
|
||||
;
|
||||
floraverse:mastodon-instance
|
||||
floraverse:mastodon-authorization-bearer
|
||||
)
|
||||
|
||||
; Internal website
|
||||
(define feuforeve:website "...")
|
||||
|
||||
; Floraverse postbot
|
||||
; Publication on Mastodon
|
||||
(define floraverse:mastodon-instance "...")
|
||||
; OAuth2 authorization bearer
|
||||
(define floraverse:mastodon-authorization-bearer "...")
|
||||
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
#lang racket
|
||||
|
||||
(require net/url
|
||||
json
|
||||
"mastodon.rkt"
|
||||
"configuration.rkt"
|
||||
srfi/8)
|
||||
|
||||
(define character-generator (string-append feuforeve:website "/CharacterGenerator/Tweet"))
|
||||
(define (pick-character)
|
||||
(read-json
|
||||
(get-pure-port
|
||||
(string->url character-generator))))
|
||||
|
||||
; Function to generate a character
|
||||
; The concatenation of strings should be less than 500 characters (mastodon limit)
|
||||
; The function generates characters as long as the limits are not respected
|
||||
; The function returns two values: a list of strings for twitter and a single string for mastodon
|
||||
(define (generate-messages)
|
||||
(define chr (pick-character))
|
||||
(define tweets (list
|
||||
(hash-ref chr 'identity)
|
||||
(hash-ref chr 'birth)
|
||||
(hash-ref chr 'motto)
|
||||
(hash-ref chr 'traits)))
|
||||
(define toot (string-join tweets "\n"))
|
||||
(if (>= (string-length toot) 500)
|
||||
(generate-messages)
|
||||
toot))
|
||||
|
||||
; Post a character
|
||||
; Send to mastodon
|
||||
(send
|
||||
(new mastodon-client%
|
||||
[instance floraverse:mastodon-instance]
|
||||
[authorization-bearer floraverse:mastodon-authorization-bearer])
|
||||
new-status
|
||||
(generate-messages)
|
||||
#:visibility "public")
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
#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))
|
||||
))))
|
||||
))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
[Unit]
|
||||
Description=generator.beleth.pink dynamic website
|
||||
|
||||
[Service]
|
||||
#User=http
|
||||
#Group=http
|
||||
WorkingDirectory=/opt/generator.beleth.ppink
|
||||
## Uncomment the next line to update the sources if:
|
||||
# - the installation is a git clone
|
||||
# - a git pull is wanted every time the server is started
|
||||
#ExecStartPre=/usr/bin/git pull
|
||||
ExecStart=/usr/bin/racket main.rkt
|
||||
|
||||
[Install]
|
||||
WantedBy=multi-user.target
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
[Unit]
|
||||
Description=Floraverse character generator Poster
|
||||
|
||||
[Service]
|
||||
#User=http
|
||||
#Group=http
|
||||
WorkingDirectory=/opt/generator.beleth.pink
|
||||
Type=oneshot
|
||||
# You should modify the configuration to change the keys and secrets
|
||||
ExecStart=/usr/bin/racket postbot/floraverse.rkt
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
[Unit]
|
||||
Description=Floraverse Character Generator Poster - Timer
|
||||
|
||||
[Timer]
|
||||
Persistent=false
|
||||
OnCalendar=*-*-* 01:00:00
|
||||
Unit=flora-character-generator-poster.service
|
||||
|
||||
[Install]
|
||||
WantedBy=timers.target
|
||||
Loading…
Reference in New Issue