1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
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)
|