cl-deck-builder2/src/models/user.lisp

#|

src/models/user.lisp

# User Interaction Backend

## Create a superuser

(create-superuser name email password)

## Create a normal user

    (bookshops.models::create-user "Joe Blogg" "JoeBlogg@example.com" "i<3books")

## Give him rights

    (add-role user :admin)

Bootstrap roles: see database.lisp bootstrap-base-roles.

# More Information

- <https://github.com/fukamachi/can>

|#

(in-package #:cl-deck-builder2.models.user)

(defclass user (has-secure-password)
  ((name :accessor name-of
         :col-type :text
         :initarg :name)
   (email :accessor user-email-of
          :col-type :text
          :initarg :email))
  (:unique-keys email)
  ;; (:primary-key email)
  (:metaclass registered-table-class)
  (:documentation "The USER class encapsulates information about the users of The Deck Builder: name, email, password, password salt, user roles."))

(defclass role ()
  ((name ;;:col-type :text
    :col-type (:varchar 64)
    :initarg :role
    :inflate (alexandria:compose #'alexandria:make-keyword #'string-upcase)
    :deflate #'string-downcase
    :accessor name-of))
  (:documentation "The ROLE class encapsulates information about the roles of actions a user may perform, e.g. :ADMIN, :USER, :BANNED.")
  (:metaclass registered-table-class)
  (:primary-key name)
  (:auto-pk nil)
  (:record-timestamps nil))

(defclass user-role ()
  ((user :col-type user
         :initarg :user
         :accessor user-role-user)
   (role :col-type role
         :initarg :role
         :accessor user-role-role))
  (:metaclass registered-table-class)
  (:primary-key user role)
  (:auto-pk nil)
  (:record-timestamps nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun create-user (name email password)
  "Create a USER object with NAME, EMAIL, and PASSWORD fields. Will automatically be synced to db via CREATE-DAO. Password hashing provided by MITO-AUTH."
  (create-dao 'user :name name
                    :email email
                    :password password))

(defun find-user (email)
  "Find a user by EMAIL."
  (find-dao 'user :email email))

;; (defun create-superuser (name email password)
;;   "Create a USER with the ADMIN role."
;;   (let ((user (create-user name email password)))
;;     (add-role user :admin)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO Role Viewer / Editor
(defun create-role (name)
  "Create a ROLE called NAME. If the ROLE exists, return that, instead."
  (with-connection (db)
    (with-transaction
      (or (mito:find-dao 'role :name name)
          (mito:create-dao 'role :name name)))))

(defun %find-role-from-keyword (role-name)
  "Return a role object from a keyword and throw an error if an associated role cannot be found"
  (let ((role (find-dao 'role :name role-name)))
    (assert role (role) "There is no role named ~a" role-name)
    role))

(defgeneric add-role (user role)
  (:documentation "Add the given role to this user. ROLE is either a role object or a symbol. An example role is ':admin`.")
  (:method ((user user) (role role))
    (or (find-dao 'user-role :user user :role role)
        (create-dao 'user-role :user user :role role)))
  (:method ((user user) (role-name symbol))
    (let ((role (%find-role-from-keyword role-name)))
      (add-role user role))))

;; Retrieving roles from "user-role" table
(defmethod user-roles-of ((user user))
  (with-connection (db)
    (with-transaction
      (mapcar #'user-role-role
              (mito:retrieve-dao 'user-role :user user)))))

(defgeneric user-has-role (user role)
  (:documentation "Given a USER and a ROLE, return T if  ROLE is a MEMBER of USER-ROLES for USER, NIL otherwise.")
  (:method ((user user) (role role))
    (member (name-of role) (user-roles-of user) :key #'name-of))
  (:method ((user user) (role-name symbol))
    (let ((role (%find-role-from-keyword role-name)))
      (user-has-role user role))))

(defmethod user-admin-p ((user user))
  "Is USER an admin? Return T if so. NIL otherwise."
  (user-has-role user :admin))

(defmethod user-verified-p ((user user))
  "Is USER in the VERIFIED role? Return T if so. NIL otherwise."
  (user-has-role user :verified))