src/model/user.lisp

DOWNLOAD
(in-package :murja.model.user)

(defclass User ()
  ((id :initarg :id :accessor user-id :col-type integer)
   (username :initarg :username :accessor user-username :col-type string)
   (password :initarg :password :accessor user-password :col-type string)
   (nickname :initarg :nickname :accessor user-nickname :col-type string)
   (img-location :initform "" :initarg :img-location :accessor user-img-location :col-type string)
   (abilities :ghost t :initarg :abilities :initform #() :accessor abilities :col-type string))

  (:metaclass postmodern:dao-class)
  (:keys id)
  (:table-name "blog.Users"))

(defmethod print-object ((usr User) output)
  (with-slots (id username nickname img-location abilities) usr
    
    (format output "#<USER: ~{~{~a: ~s~}~^,~%~t ~}>" (list
						  (list :id id)
						  (list :username username)
						  (list :nickname nickname)
						  (list :password "******")
						  (list :img-location img-location)
						  (list :abilities abilities)))))

(defparameter *user-query*
  "SELECT
  u.id,
  u.username,
  u.nickname,
  u.img_location,
  u.password,
  json_agg(DISTINCT perm.action) as abilities
FROM
  blog.users u
  left JOIN blog.groupmapping gm ON u.id = gm.userid
  left JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
  left JOIN blog.permission perm ON gp.permissionid = perm.id
WHERE
  u.id = $1
GROUP BY
  u.id;")

(defparameter *user-query-with-password*
    "SELECT
  u.id,
  u.username,
  u.nickname,
  u.img_location,
  u.password,
  json_agg(DISTINCT perm.action) as abilities
FROM
  blog.users u
  left JOIN blog.groupmapping gm ON u.id = gm.userid
  left JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
  left JOIN blog.permission perm ON gp.permissionid = perm.id
WHERE
  WHERE u.Username = $1 AND u.Password = $2
GROUP BY
  u.id;")

(defun get-user (id-or-username &optional password)
  "Gets user and populates its abilities"
  (let ((usr (if password
		 (postmodern:query *user-query-with-password* id-or-username password (:dao User :single))
		 (postmodern:query *user-query* id-or-username (:dao User :single)))))
    (with-slots (abilities) usr 
      (when (stringp abilities)
	(setf abilities (json:parse abilities))))
    usr))
		       

;; (postmodern:get-dao 'User 1)

;; (get-user 1)



(defun register-user (username nickname img-location password)
  "Inserts the new user into db and returns its id" 
  (caar (postmodern:query "INSERT INTO blog.Users (username, nickname, img_location, password) VALUES ($1, $2, $3, $4) returning id"
			  username
			  nickname
			  img-location
			  (lisp-fixup:sha-512 password))))