From 379b35093097f0091e08e128c161000ead3d1e19 Mon Sep 17 00:00:00 2001 From: Benji Dial Date: Mon, 6 May 2024 03:05:16 -0400 Subject: new version --- source.rkt | 149 ------------------------------------------------------------- 1 file changed, 149 deletions(-) delete mode 100644 source.rkt (limited to 'source.rkt') diff --git a/source.rkt b/source.rkt deleted file mode 100644 index 1560993..0000000 --- a/source.rkt +++ /dev/null @@ -1,149 +0,0 @@ -#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) -- cgit v1.2.3