new version

1 files changed, 0 insertions, 149 deletions

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)