#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)