122 lines
4.0 KiB
Racket
122 lines
4.0 KiB
Racket
#lang racket
|
|
|
|
(require racket/async-channel
|
|
json
|
|
net/url
|
|
net/uri-codec
|
|
; net/rfc6455
|
|
uuid)
|
|
|
|
(provide [struct-out app-config]
|
|
config-from-file
|
|
current-config
|
|
make-toot
|
|
send-toot
|
|
send-toot/retry-on-err
|
|
verify-creds
|
|
; stream-user
|
|
fetch-toot)
|
|
|
|
;; Bot configuration
|
|
(struct app-config [instance token char-limit] #:transparent)
|
|
|
|
(define (config-from-file filename)
|
|
(define conf (with-input-from-file filename read))
|
|
;; this could be a macro
|
|
(app-config
|
|
(hash-ref conf 'instance)
|
|
(hash-ref conf 'token)
|
|
(hash-ref conf 'char-limit 500)))
|
|
|
|
;; Represents the current masto config
|
|
(define current-config (make-parameter #f))
|
|
|
|
;; Utils
|
|
(define (make-api-url path #:ws? [ws? #f] #:query [query '()])
|
|
(url (if ws? "wss" "https")
|
|
#f (app-config-instance (current-config))
|
|
#f #t
|
|
`(,(path/param "api" '())
|
|
,(path/param "v1" '())
|
|
,@(map (lambda (x) (path/param x '())) path))
|
|
query #f))
|
|
|
|
(define (make-header k v)
|
|
(string-append k ": " v))
|
|
|
|
(define (get-authorization)
|
|
(string-append "Bearer " (app-config-token (current-config))))
|
|
|
|
(define (guard-config)
|
|
(unless (app-config? (current-config))
|
|
(error "current-config is not set up")))
|
|
|
|
;; Creates a toot
|
|
(define (make-toot status #:cw [cw #f] #:reply-to [reply-to #f]
|
|
#:sensitive [sensitive #f] #:language [lang #f]
|
|
#:visibility [visibility #f])
|
|
(for/fold ([out '()])
|
|
([name '(status in_reply_to_id sensitive spoiler_text language visibility)]
|
|
[value (list status reply-to sensitive cw lang visibility)])
|
|
(cond [(false? value) out]
|
|
[else (cons (cons name value) out)])))
|
|
|
|
;; Sends a toot
|
|
(define (send-toot toot [idem-key (uuid-string)])
|
|
(guard-config)
|
|
(define-values (status headers rsp)
|
|
(http-sendrecv/url (make-api-url '("statuses"))
|
|
#:method "POST"
|
|
#:headers (list
|
|
(make-header "Idempotency-Key" idem-key)
|
|
(make-header "Authorization" (get-authorization))
|
|
(make-header "Content-Type" "application/x-www-form-urlencoded"))
|
|
#:data (alist->form-urlencoded toot)))
|
|
(string->jsexpr (port->string rsp)))
|
|
|
|
(define MAX-TRIES 10)
|
|
(define SLEEP-CAP 60)
|
|
|
|
(define (send-toot/retry-on-err toot [idem-key (uuid-string)] [tries 0])
|
|
(guard-config)
|
|
(define (handle-err ex)
|
|
(displayln "toot failed")
|
|
(displayln ex)
|
|
(if (>= tries MAX-TRIES)
|
|
(raise ex)
|
|
(begin
|
|
(sleep (min SLEEP-CAP (* tries 5)))
|
|
(send-toot/retry-on-err toot idem-key (add1 tries)))))
|
|
(with-handlers ([exn? handle-err])
|
|
(send-toot toot idem-key)))
|
|
|
|
(define (verify-creds)
|
|
(guard-config)
|
|
(define-values (status headers rsp)
|
|
(http-sendrecv/url (make-api-url '("accounts" "verify_credentials"))
|
|
#:headers (list (make-header "Authorization" (get-authorization)))))
|
|
(string->jsexpr (port->string rsp)))
|
|
|
|
(define (fetch-toot toot-id)
|
|
(guard-config)
|
|
(define-values (status headers rsp)
|
|
(http-sendrecv/url (make-api-url (list "statuses" toot-id))
|
|
#:headers (list (make-header "Authorization" (get-authorization)))))
|
|
(string->jsexpr (port->string rsp)))
|
|
|
|
;; Stream incoming toots
|
|
; (define (stream-user chan)
|
|
; (define query (list (cons 'access_token (app-config-token (current-config)))
|
|
; (cons 'stream "user")))
|
|
; (define ws (ws-connect (make-api-url '("streaming") #:ws? #t #:query query)))
|
|
; (define (stream-forever chan)
|
|
; (let ([msg (ws-recv ws)])
|
|
; (cond [(equal? msg eof) (void)]
|
|
; [else
|
|
; (define msg-data (string->jsexpr msg)
|
|
; (async-channel-put chan (list (hash-ref msg-data 'event)
|
|
; (hash-ref msg-data 'payload)))
|
|
; (stream-forever chan)])))
|
|
; (stream-forever chan)
|
|
; (ws-close! ws))
|