From f05e422f697c94edc2983b857dc814aedb7aaa9b Mon Sep 17 00:00:00 2001 From: Benji Dial <benji@benjidial.net> Date: Sun, 5 May 2024 16:21:07 -0400 Subject: [PATCH] first commit --- readme.txt | 1 + source.rkt | 149 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 150 insertions(+) create mode 100644 readme.txt create mode 100644 source.rkt diff --git a/readme.txt b/readme.txt new file mode 100644 index 0000000..fdb5cc1 --- /dev/null +++ b/readme.txt @@ -0,0 +1 @@ +to do: write readme. diff --git a/source.rkt b/source.rkt new file mode 100644 index 0000000..1560993 --- /dev/null +++ b/source.rkt @@ -0,0 +1,149 @@ +#lang racket + +(require net/url) +(require json) +(require db) + +(define polls-per-day 4) ; configurable, set to any positive integer +(define midnight-seconds (* 4 3600)) ; UTC-4, adjust accordingly +(define channel-id "CHANNEL ID") ;replace this with the channel id, as a string +(define bot-token "BOT TOKEN") ; replace this with the bot token, as a string + +(when (or (eq? channel-id "CHANNEL ID") (eq? bot-token "BOT TOKEN")) + (display "Please set the channel-id and bot-token variables.") + (newline) + (exit)) + +(define dbc (sqlite3-connect #:database "database.db" #:mode 'create)) + +(unless (table-exists? dbc "entries") + (unless (file-exists? "entries.txt") + (display "Please put the entries into a file named entries.txt, separated by newlines.") + (newline) + (exit)) + (start-transaction dbc) + (query-exec dbc "create table entries (name text unique not null, round int not null)") + (query-exec dbc "create table open_polls (round int not null, msg_id text not null)") + (query-exec dbc "create table closed_polls (round int not null, entry_1 text not null, entry_2 text not null, voters_1 text not null, voters_2 text not null)") + (for ((entry (string-split (port->string (open-input-file "entries.txt") #:close? #t) "\n"))) + (query-exec dbc "insert into entries (name, round) values (?, 1)" entry)) + (commit-transaction dbc)) + +(define (api-get endpoint) + (string->jsexpr + (port->string + (get-pure-port + (string->url (string-append "https://discord.com/api/v10" endpoint)) + (list (string-append "Authorization: Bot " bot-token))) + #:close? #t))) + +(define (api-post endpoint content) + (string->jsexpr + (port->string + (post-pure-port + (string->url (string-append "https://discord.com/api/v10" endpoint)) + (string->bytes/utf-8 (jsexpr->string content)) + (list + (string-append "Authorization: Bot " bot-token) + "Content-Type: application/json")) + #:close? #t))) + +(define (get-completed-poll-answers msg-id (sleep-time 1)) + (let ((resp (api-get (string-append "/channels/" channel-id "/messages/" msg-id)))) + (if (hash-ref (hash-ref (hash-ref resp 'poll) 'results) 'is_finalized) + (hash-ref (hash-ref resp 'poll) 'answers) + (begin + (sleep sleep-time) + (get-completed-poll-answers msg-id (* sleep-time 2)))))) + +(define (get-users msg-id answer-id (so-far '()) (last-user #f)) + (let* ((base-endpoint + (string-append + "/channels/" channel-id "/polls/" msg-id "/answers/" (number->string answer-id) "?limit=100")) + (resp (api-get (if last-user (string-append base-endpoint "&after=" last-user) base-endpoint))) + (users (hash-ref resp 'users)) + (user-ids (map (lambda (s) (hash-ref s 'id)) users))) + (if (empty? user-ids) + so-far + (get-users msg-id answer-id (append user-ids so-far) (last user-ids))))) + +(define (process-completed-poll round msg-id) + (api-post (string-append "/channels/" channel-id "/polls/" msg-id "/expire") (make-hash)) + (let* ((answers (get-completed-poll-answers msg-id)) + (e1id (hash-ref (car answers) 'answer_id)) + (e2id (hash-ref (cadr answers) 'answer_id)) + (e1t (hash-ref (hash-ref (car answers) 'poll_media) 'text)) + (e2t (hash-ref (hash-ref (cadr answers) 'poll_media) 'text)) + (e1u (get-users msg-id e1id)) + (e2u (get-users msg-id e2id)) + (e1w (>= (length e1u) (length e2u))) + (e2w (>= (length e2u) (length e1u)))) + (start-transaction dbc) + (query-exec dbc + "insert into closed_polls (round, entry_1, entry_2, voters_1, voters_2) values (?, ?, ?, ?, ?)" + round e1t e2t (string-join e1u ",") (string-join e2u ",")) + (query-exec dbc "delete from open_polls where msg_id = ?" msg-id) + (query-exec dbc "update entries set round = ? where name = ?" (if e1w (+ round 1) 0) e1t) + (query-exec dbc "update entries set round = ? where name = ?" (if e2w (+ round 1) 0) e2t) + (commit-transaction dbc))) + +(define (create-poll e1 e2 round poll-number) + (let ((resp (api-post + (string-append "/channels/" channel-id "/messages") + (hash + 'poll (hash + 'question (hash 'text (string-append "Today's Poll #" (number->string poll-number))) + 'answers (list (hash 'poll_media (hash 'text e1)) (hash 'poll_media (hash 'text e2))) + 'duration 23))))) + (query-exec dbc "insert into open_polls (round, msg_id) values (?, ?)" round (hash-ref resp 'id)))) + +(define (send-message msg) + (api-post + (string-append "/channels/" channel-id "/messages") + (hash 'content msg))) + +(define (sleep-until-next) + (sleep 2) + (sleep (modulo (- midnight-seconds (current-seconds)) 86400))) + +(sleep-until-next) +(for ((row (query-rows dbc "select * from open_polls"))) + (process-completed-poll (vector-ref row 0) (vector-ref row 1))) + +(define on-round (apply min (query-list dbc "select distinct round from entries where round > 0"))) +(define this-round (shuffle (query-list dbc "select name from entries where round = ?" on-round))) + +(define (main-loop) + (define last-remaining #f) + (when (= 1 (length this-round)) + (set! last-remaining (car this-round)) + (query-exec dbc "update entries set round = ? where name = ?" (+ 1 on-round) (car this-round)) + (set! this-round '())) + (when (= 0 (length this-round)) + (set! on-round (+ 1 on-round)) + (set! this-round (shuffle (query-list dbc "select name from entries where round = ?" on-round))) + (when (= 1 (length this-round)) + (send-message (string-append "# WINNER WINNER\n## " (string-upcase (car this-round)))) + (exit)) + (send-message + (string-append + "# ROUND " (number->string on-round) + (if last-remaining + (string-append + "\nThe only entry remaining in the previous round was \"" + last-remaining "\", so it advanced. ") + "\n") + (number->string (length this-round)) " entries remain:\n* " + (string-join this-round "\n* ")))) + (if (file-exists? "SKIP-TODAY") + (send-message "There is no poll today :)") + (for ((i (range polls-per-day))) + (when (> (length this-round) 1) + (create-poll (car this-round) (cadr this-round) on-round (+ 1 i)) + (set! this-round (cddr this-round))))) + (sleep-until-next) + (for ((row (query-rows dbc "select * from open_polls"))) + (process-completed-poll (vector-ref row 0) (vector-ref row 1))) + (main-loop)) + +(main-loop)