#lang racket

(require koyo/random)
(require smtp)
(require db)

(require "config.rkt")

(provide
  make-signin-key
  create-user
  verify-signin-key
  create-session
  user-exists
  no-outstanding-signin
  remove-session
  session-to-user-id)

(current-smtp-host email-server)
(current-smtp-port email-port)
(current-smtp-username email-user)
(current-smtp-password email-password)

(define (valid-user-id str)
  (let ((lst (map char->integer (string->list str))))
    (and
      (for/or ((c lst))
        (and (>= c (char->integer #\a)) (<= c (char->integer #\z))))
      (for/and ((c lst))
        (or
          (and (>= c (char->integer #\a)) (<= c (char->integer #\z)))
          (and (>= c (char->integer #\0)) (<= c (char->integer #\9)))
          (= c (char->integer #\.)))))))

;nothing breaks if an invalid email is used, this is just used as a sanity check against form input
(define (valid-email str)
  (string-contains? str "@"))

(define dbc
  (sqlite3-connect
    #:database "database.db"
    #:mode 'create))

(query-exec dbc
  "CREATE TABLE IF NOT EXISTS users (user_id TEXT PRIMARY KEY, email TEXT UNIQUE NOT NULL, email_verified INTEGER NOT NULL)")
(query-exec dbc
  "CREATE TABLE IF NOT EXISTS signin_keys (user_id TEXT PRIMARY KEY, key TEXT NOT NULL, expires INTEGER NOT NULL)")
(query-exec dbc
  "CREATE TABLE IF NOT EXISTS sessions (session_id TEXT PRIMARY KEY, user_id TEXT UNIQUE NOT NULL, expires INTEGER NOT NULL)")

;returns boolean
(define (email-verified user-id)
  (query-maybe-value dbc "SELECT 1 FROM users WHERE user_id = $1 AND email_verified = 1" user-id))

(define (user-exists user-id)
  (query-maybe-value dbc "SELECT 1 FROM users WHERE user_id = $1" user-id))

(define (no-outstanding-signin user-id)
  (let ((expires (query-maybe-value dbc "SELECT expires FROM signin_keys WHERE user_id = $1" user-id)))
    (if expires
      (<= expires (current-seconds))
      #t)))

(define (session-to-user-id session-id)
  (let ((row (query-maybe-row dbc "SELECT user_id, expires FROM sessions WHERE session_id = $1" session-id)))
    (if row
      (let ((user-id (vector-ref row 0))
            (expires (vector-ref row 1)))
        (if (> expires (current-seconds))
          user-id
          #f))
      #f)))

;returns nothing
(define (make-signin-key user-id)
  (let ((key (generate-random-string))
        (expires (+ (current-seconds) signin-key-time))
        (email-to (query-value dbc "SELECT email FROM users WHERE user_id = $1" user-id)))
    (with-handlers ((exn:fail? (lambda (_) (void))))
      (send-smtp-mail
        (make-mail
          "Login key"
          (string-append "Your signin key is: " key "\nThis key is only valid for one signin. Do not share this key with anyone.")
          #:from email-from
          #:to `(,email-to))))
    (query-exec dbc
      "REPLACE INTO signin_keys (user_id, key, expires) VALUES ($1, $2, $3)" user-id key expires)))

;returns boolean
(define (email-in-use email)
  (query-maybe-value dbc "SELECT 1 FROM users WHERE email = $1 AND email_verified = 1" email))

;returns boolean
(define (create-user user-id email)
  (if (or
        (email-verified user-id)
        (email-in-use email)
        (not (valid-user-id user-id))
        (not (valid-email email)))
    #f
    (begin
      (query-exec dbc "DELETE FROM users WHERE user_id = $1 OR email = $2" user-id email)
      (query-exec dbc
        "INSERT INTO users (user_id, email, email_verified) VALUES ($1, $2, 0)" user-id email)
      (make-signin-key user-id)
      #t)))

;returns boolean
(define (verify-signin-key user-id key)
  (let ((expires
          (query-maybe-value dbc
            "SELECT expires FROM signin_keys WHERE user_id = $1 AND key = $2" user-id key)))
    (if expires
      (begin
        (query-exec dbc "DELETE FROM signin_keys WHERE user_id = $1" user-id)
        (> expires (current-seconds)))
      #f)))

;returns session id
(define (create-session user-id)
  (let ((session-id (generate-random-string))
        (expires (+ (current-seconds) session-time)))
    (query-exec dbc "DELETE FROM sessions WHERE user_id = $1" user-id)
    (query-exec dbc
      "REPLACE INTO sessions (session_id, user_id, expires) VALUES ($1, $2, $3)"
      session-id user-id expires)
    (query-exec dbc "UPDATE users SET email_verified = 1 WHERE user_id = $1" user-id)
    session-id))

(define (remove-session user-id)
  (query-exec dbc "DELETE FROM sessions WHERE user_id = $1" user-id))