#!/usr/bin/env racket
#lang racket
(require srfi/98)
(require net/uri-codec)
(require net/smtp)

(define ERROR-HEADER "Location: http://csclub.uwaterloo.ca/opencl/register-fail\n\n")
(define SUCCESS-HEADER "Location: http://csclub.uwaterloo.ca/opencl/register-success\n\n")

(define (is-user? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._]+" str)))
(define (is-email? str) (equal? (list str) (regexp-match #rx"[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+" str)))

(define required-fields `( (quest . ,is-user?) (email . ,is-email?)))
(define check-fields '(team open closed))

(define (identity x) x)

(let*
  ((post-data (form-urlencoded->alist (port->string)))
   (required-extract
     (map
       (lambda(x) (let ((e (assoc (car x) post-data)))
                       (cond [(false? e) #f]
                             [((cdr x) (cdr e)) e]
                             [else #f])))
       required-fields))
   (check-extract (filter identity (map ((curryr assoc) post-data) check-fields)))
   (filled-out? (andmap identity required-extract)))
  (when (not filled-out?)
    (printf ERROR-HEADER)
    (exit 0))
  (smtp-send-message
    "caffeine.csclub.uwaterloo.ca"
    "opencl-contest-registration@csclub"
    (list "init512@gmail.com")
    "Subject: Contestant registered!\n\n"
    (list (with-output-to-string
      (lambda() (write (append required-extract check-extract))))))
  (printf SUCCESS-HEADER)
  (exit 0))