#lang racket/base

; User abstraction
; A user is stored in a database, so it uses the stored-class definitions.

(require
  "stored-objects.rkt"
  file/sha1
  net/base64
  racket/random
  )
(provide
  user-init-repository
  hash-password
  new-user get-user-by-id get-user-by-name update-user-info remove-user get-all-users
  user-name user-pseudo user-about user-icon user-check-password
  same-user?
  new-usercookie update-usercookie-by-value remove-usercookie-by-value remove-expired-usercookies
  usercookie-value usercookie-expires
  get-user-by-usercookie-value
  )

; User definition
(stored-class user
  (name : string?) ; User name
  (hashpw : string?) ; hashed password
  (pseudo : string?) ; Display name
  (about : string?) ; About page of the user
  (icon : string?) ; Icon/Avatar of the user
  )

; User cookies
(stored-class usercookie
  (value : bytes?)
  (expires : integer?) ; Date of expiration
  (user : integer?) ; (user?) Identifier of user
  )

; Key used for cookie
(define *cookie-key* "notepad")

; Add the definitions to a repository
(define (user-init-repository repo)
  (init-repository repo
    user usercookie))

; Compute the password hash of a user
(define (hash-password username password)
  (bytes->hex-string
    (sha256-bytes
      (string->bytes/utf-8
        (string-append username password))))) ; TODO: add a salt

; Create a new user, and return it
(define (new-user name password)
  (within-transaction (class-repository user)
    (define usr (instanciate user))
    (set-user-name! usr name)
    (set-user-hashpw! usr (hash-password name password))
    (set-user-pseudo! usr name)
    (set-user-about! usr "")
    (set-user-icon! usr "")
    (save-instance usr)
    usr))

; Get user by id
(define (get-user-by-id id)
  (find-instance-by-id user id))

; Get user by name
(define (get-user-by-name name)
  (define usrs (find-instances user `((name . ,name))))
  (and (not (null? usrs))
       (car usrs)))

; Update user information
(define (update-user-info usr
          #:pseudo [pseudo #f]
          #:about [about #f]
          #:icon [icon #f])
  (within-transaction (class-repository user)
    (and pseudo (set-user-pseudo! usr pseudo))
    (and about (set-user-about! usr about))
    (and icon (set-user-icon! usr icon))
    (save-instance usr)
    usr))

; Remove user
(define (remove-user usr)
  (define usr-id (instance-identifier usr))
  (within-transaction (class-repository user)
    ; Remove all cookies of user
    (delete-instances usercookie `((user . ,usr-id)))
    ; Remove user
    (delete-instance usr)))

; Get all users
(define (get-all-users)
  (list-instances user))

; Check user password
(define (user-check-password usr password)
  (and usr password
       (equal? (hash-password (user-name usr) password)
               (user-hashpw usr))))

; Same user?
(define (same-user? usr1 usr2)
  (and
    usr1 usr2
    (eq? (instance-identifier usr1)
         (instance-identifier usr2))))

; Expiration date in seconds, absolute
(define (new-cookie-expiration-date)
  (+ (current-seconds) (* 10 24 60 60))) ; Cookie are valid for 10 days

; Create a cookie for a user
(define (new-usercookie usr)
  (define value (base64-encode (crypto-random-bytes 128) #""))
  ; TODO: race condition ?
  (cond
    ((get-usercookie-by-value value)
     ; A cookie with the same value already exist: try again
     (new-usercookie usr))
    (#t
      ; Create the cookie
      (define expires (new-cookie-expiration-date))
      (within-transaction (class-repository usercookie)
        (define instance (instanciate usercookie))
        (set-usercookie-value! instance value)
        (set-usercookie-expires! instance expires)
        (set-usercookie-user! instance (instance-identifier usr))
        (save-instance instance)
        instance))))

; Get cookie by value
(define (get-usercookie-by-value value)
  (define instances (find-instances usercookie `((value . ,value))))
  (and (not (null? instances)) (car instances)))

; Update the expiration date of a cookie and return the cookie
(define (update-usercookie-by-value value)
  (within-transaction (class-repository usercookie)
    (define cookie (get-usercookie-by-value value))
    (cond
      (cookie
        (define expires (new-cookie-expiration-date))
        (set-usercookie-expires! cookie expires)
        (save-instance cookie)
        cookie)
      (#t
        #f))))

; Remove a cookie from its value
(define (remove-usercookie-by-value value)
  (within-transaction (class-repository usercookie)
    (define cookie (get-usercookie-by-value value))
    (when cookie
      (delete-instance cookie))))

; Remove all expired cookies
(define (remove-expired-usercookies)
  (within-transaction (class-repository usercookie)
    (for-each
      delete-instance
      (filter
        (lambda (c)
          (< (usercookie-expires c) (current-seconds)))
        (list-instances usercookie)))))

; Get user by cookie
(define (get-user-by-usercookie-value value)
  (within-transaction (class-repository usercookie)
    (define cookie (get-usercookie-by-value value))
    (cond
      ((and cookie (not (< (usercookie-expires cookie) (current-seconds))))
        ; Cookie exists and has not expired => return associated user
        (get-user-by-id (usercookie-user cookie)))
      (cookie
        ; Cookie exists but has expired => remove cookie, and return "user not found"
        (delete-instance cookie)
        #f)
      (#t
        ; Cookie does not exists => user not found
        #f))))
