Add postbots.
This commit is contained in:
Feufochmar
parent
d027f1d69f
commit
cb53046279
|
|
@ -0,0 +1,33 @@
|
|||
#lang racket
|
||||
|
||||
(require net/url
|
||||
"mastodon.rkt"
|
||||
"twitter.rkt"
|
||||
"configuration.rkt")
|
||||
|
||||
; Do an API call to the website
|
||||
(define arnytron-generator (string-append feuforeve:website "/ArnYtron3000/brut"))
|
||||
(define quote (port->string (get-pure-port (string->url arnytron-generator))))
|
||||
|
||||
; Send to mastodon
|
||||
(display
|
||||
(send
|
||||
(new mastodon-client%
|
||||
[instance arnytron:mastodon-instance]
|
||||
[authorization-bearer arnytron:mastodon-authorization-bearer])
|
||||
new-status
|
||||
quote
|
||||
#:visibility "unlisted"))
|
||||
(newline)
|
||||
|
||||
; Publication on Twitter
|
||||
(display
|
||||
(send
|
||||
(new twitter-client%
|
||||
[consumer-key arnytron:twitter-consumer-key]
|
||||
[consumer-secret arnytron:twitter-consumer-secret]
|
||||
[access-key arnytron:twitter-access-token]
|
||||
[access-secret arnytron:twitter-access-token-secret])
|
||||
status-update
|
||||
quote))
|
||||
(newline)
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
#lang racket/base
|
||||
|
||||
; Configuration parameters for bots
|
||||
(provide
|
||||
feuforeve:website
|
||||
;
|
||||
arnytron:mastodon-instance
|
||||
arnytron:mastodon-authorization-bearer
|
||||
arnytron:twitter-consumer-key
|
||||
arnytron:twitter-consumer-secret
|
||||
arnytron:twitter-access-token
|
||||
arnytron:twitter-access-token-secret
|
||||
;
|
||||
floraverse:mastodon-instance
|
||||
floraverse:mastodon-authorization-bearer
|
||||
floraverse:twitter-consumer-key
|
||||
floraverse:twitter-consumer-secret
|
||||
floraverse:twitter-access-token
|
||||
floraverse:twitter-access-token-secret
|
||||
;
|
||||
daily-island:mastodon-instance
|
||||
daily-island:mastodon-authorization-bearer
|
||||
)
|
||||
|
||||
; Internal website
|
||||
(define feuforeve:website "...")
|
||||
|
||||
; ArnYtron postbot
|
||||
; Publication on Mastodon
|
||||
(define arnytron:mastodon-instance "...")
|
||||
; OAuth2 authorization bearer
|
||||
(define arnytron:mastodon-authorization-bearer "...")
|
||||
; Twitter keys
|
||||
(define arnytron:twitter-consumer-key "...")
|
||||
(define arnytron:twitter-consumer-secret "...")
|
||||
(define arnytron:twitter-access-token "...")
|
||||
(define arnytron:twitter-access-token-secret "...")
|
||||
|
||||
; Floraverse postbot
|
||||
; Publication on Mastodon
|
||||
(define floraverse:mastodon-instance "...")
|
||||
; OAuth2 authorization bearer
|
||||
(define floraverse:mastodon-authorization-bearer "...")
|
||||
; Twitter keys
|
||||
(define floraverse:twitter-consumer-key "...")
|
||||
(define floraverse:twitter-consumer-secret "...")
|
||||
(define floraverse:twitter-access-token "...")
|
||||
(define floraverse:twitter-access-token-secret "...")
|
||||
|
||||
; Daily Island postbot
|
||||
; Publication on Mastodon
|
||||
(define daily-island:mastodon-instance "...")
|
||||
; OAuth2 authorization bearer
|
||||
(define daily-island:mastodon-authorization-bearer "...")
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
#lang racket
|
||||
|
||||
(require net/url
|
||||
json
|
||||
"mastodon.rkt"
|
||||
"twitter.rkt"
|
||||
"configuration.rkt"
|
||||
srfi/8)
|
||||
|
||||
(define character-generator (string-append feuforeve:website "/Floraverse/CharacterGenerator/Tweet"))
|
||||
(define (pick-character)
|
||||
(read-json
|
||||
(get-pure-port
|
||||
(string->url character-generator))))
|
||||
|
||||
; Function to generate a character
|
||||
; Each string defining the character should be less than 140 characters (twitter limit)
|
||||
; 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 (or (>= (string-length toot) 500)
|
||||
(member #t (map (lambda (x) (>= (string-length x) 140)) tweets)))
|
||||
(generate-messages)
|
||||
(values tweets toot)))
|
||||
|
||||
; Post a character
|
||||
(receive
|
||||
(tweets toot) (generate-messages)
|
||||
; Send to mastodon
|
||||
(send
|
||||
(new mastodon-client%
|
||||
[instance floraverse:mastodon-instance]
|
||||
[authorization-bearer floraverse:mastodon-authorization-bearer])
|
||||
new-status
|
||||
toot
|
||||
#:visibility "public")
|
||||
; Send to twitter
|
||||
(define client (new twitter-client%
|
||||
[consumer-key floraverse:twitter-consumer-key]
|
||||
[consumer-secret floraverse:twitter-consumer-secret]
|
||||
[access-key floraverse:twitter-access-token]
|
||||
[access-secret floraverse:twitter-access-token-secret]))
|
||||
(foldl
|
||||
(lambda (message id-previous)
|
||||
(hash-ref
|
||||
(send
|
||||
client
|
||||
status-update
|
||||
message
|
||||
#:in-reply-to-id id-previous)
|
||||
'id_str))
|
||||
#f
|
||||
tweets))
|
||||
|
|
@ -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,119 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/class
|
||||
racket/string
|
||||
net/url
|
||||
net/uri-codec
|
||||
json
|
||||
racket/date
|
||||
web-server/stuffers/hmac-sha1
|
||||
net/base64)
|
||||
|
||||
(provide twitter-client%)
|
||||
|
||||
(define twitter-client%
|
||||
(class object%
|
||||
; Needs the various OAuth keys and secrets
|
||||
(init consumer-key consumer-secret access-key access-secret)
|
||||
(super-new)
|
||||
;
|
||||
(define twitter-consumer-key consumer-key)
|
||||
(define twitter-consumer-secret consumer-secret)
|
||||
(define twitter-access-token access-key)
|
||||
(define twitter-access-token-secret access-secret)
|
||||
; Twitter root
|
||||
(define twitter-root "https://api.twitter.com/1.1")
|
||||
;
|
||||
; Private methods for OAuth 1.0
|
||||
; To generate timestamp & nonce
|
||||
(define (get-timestamp) (number->string (current-seconds)))
|
||||
; Compute the parameter string
|
||||
; The oauth-headers and parameters are lists of (key . value)
|
||||
(define (compute-signature-parameter-string oauth-headers parameters)
|
||||
(string-join
|
||||
(sort
|
||||
(map
|
||||
(lambda (x)
|
||||
(string-append (uri-unreserved-encode (car x)) "=" (uri-unreserved-encode (cdr x))))
|
||||
(append oauth-headers parameters))
|
||||
string<?)
|
||||
"&"))
|
||||
; compute the signature base string
|
||||
(define (compute-signature-base-string request-type url parameter-string)
|
||||
(string-append
|
||||
(string-upcase request-type)
|
||||
"&"
|
||||
(uri-unreserved-encode url)
|
||||
"&"
|
||||
(uri-unreserved-encode parameter-string)))
|
||||
; compute the signature key
|
||||
(define (compute-signature-key)
|
||||
(string-append
|
||||
(uri-unreserved-encode twitter-consumer-secret)
|
||||
"&"
|
||||
(uri-unreserved-encode twitter-access-token-secret)))
|
||||
; compute the signature
|
||||
(define (compute-signature signature-key signature-base-string)
|
||||
(bytes->string/utf-8
|
||||
(base64-encode
|
||||
(HMAC-SHA1
|
||||
(string->bytes/utf-8 signature-key)
|
||||
(string->bytes/utf-8 signature-base-string))
|
||||
#"")))
|
||||
; compute the signature from the request
|
||||
(define (compute-signature-from-request request-type url oauth-headers parameters)
|
||||
(compute-signature
|
||||
(compute-signature-key)
|
||||
(compute-signature-base-string
|
||||
request-type
|
||||
url
|
||||
(compute-signature-parameter-string
|
||||
oauth-headers
|
||||
parameters))))
|
||||
;
|
||||
; Post a new status
|
||||
; Return a dictionnary corresponding to the json structure returned by the server
|
||||
(define/public (status-update status
|
||||
#:in-reply-to-id [in-reply-to-id #f])
|
||||
(let*
|
||||
((url (string-append twitter-root "/statuses/update.json"))
|
||||
(parameters
|
||||
(append
|
||||
(list (cons "status" status))
|
||||
(if in-reply-to-id
|
||||
(list
|
||||
(cons "in_reply_to_status_id" in-reply-to-id)
|
||||
(cons "auto_populate_reply_metadata" "true"))
|
||||
(list))
|
||||
))
|
||||
(timestamp (get-timestamp))
|
||||
(oauth-headers
|
||||
(list
|
||||
(cons "oauth_consumer_key" twitter-consumer-key)
|
||||
(cons "oauth_token" twitter-access-token)
|
||||
(cons "oauth_version" "1.0")
|
||||
(cons "oauth_timestamp" timestamp)
|
||||
(cons "oauth_nonce" timestamp)
|
||||
(cons "oauth_signature_method" "HMAC-SHA1"))))
|
||||
(read-json
|
||||
(post-pure-port
|
||||
(string->url url)
|
||||
(string->bytes/utf-8
|
||||
(string-join
|
||||
(map
|
||||
(lambda (x) (string-append (uri-unreserved-encode (car x)) "=" (uri-unreserved-encode (cdr x))))
|
||||
parameters)
|
||||
"&"))
|
||||
(list
|
||||
"Content-Type: application/x-www-form-urlencoded"
|
||||
(string-append
|
||||
"Authorization: OAuth "
|
||||
"realm=\"\","
|
||||
(string-join
|
||||
(map
|
||||
(lambda (x) (string-append (uri-unreserved-encode (car x)) "=\"" (uri-unreserved-encode (cdr x)) "\""))
|
||||
oauth-headers)
|
||||
",")
|
||||
",oauth_signature=\"" (uri-unreserved-encode (compute-signature-from-request "POST" url oauth-headers parameters)) "\"")
|
||||
)))))
|
||||
))
|
||||
Loading…
Reference in New Issue