diff options
| -rw-r--r-- | login.lisp | 21 | ||||
| -rw-r--r-- | model.lisp | 12 | ||||
| -rw-r--r-- | session.lisp | 11 | ||||
| -rw-r--r-- | user.lisp | 1 | ||||
| -rw-r--r-- | utilities.lisp | 10 | ||||
| -rw-r--r-- | vampire.asd | 1 | ||||
| -rw-r--r-- | vampire.lisp | 14 |
7 files changed, 52 insertions, 18 deletions
diff --git a/login.lisp b/login.lisp new file mode 100644 index 0000000..2e7c652 --- /dev/null +++ b/login.lisp @@ -0,0 +1,21 @@ +;;;; login.lisp + +(in-package :vampire) + +(defun login-page (body) + (with-clog-create body + (div () + (div () + (section (:h3 :content "LOGIN")) + (form () + (form-element (:text :bind name-input)) + (br ()) + (form-element (:password :bind pw-input)) + (br ()) + (button (:bind btn :content "Click here to log in")))) + (div () + (:p () + (:a (:link "/new-account" :content "Create an account"))))) + (setf (place-holder name-input) "Name" + (place-holder pw-input) "Password"))) + @@ -9,9 +9,11 @@ :index-reader object-with-key))) (defclass/bknr user (keyed) - ((name :with :std "") + ((name :with + :index-type string-unique-index + :index-reader user-with-name) (playlists :with :std (list)) - (pw pwhash :with))) + (pwsalt pwhash :with))) (defclass/bknr playlist (keyed) ((title :with :std (default-name "playlist")) @@ -36,6 +38,12 @@ (when (typep obj 'user) obj))) +(defun login-user (username password) + (when-let (user (user-with-name username)) + (with-slots (pwhash pwsalt) user + (when (equalp pwhash (hash-string password pwsalt)) + user)))) + (defun playlist-duration (pl) (reduce #'+ (playlist-tracks pl) diff --git a/session.lisp b/session.lisp index 770bc8d..0ad10c2 100644 --- a/session.lisp +++ b/session.lisp @@ -2,7 +2,12 @@ (in-package :vampire) -;;; session parameter keys +;;; SESSION CLASS + +(defclass/bknr session (keyed) + ((user :std (error "Sessions must be associated with users.")))) + +;;; SESSION PARAMETER KEYS (defparameter +session-key+ "vampire-session-key" "Stored in the browser's local storage") @@ -19,7 +24,9 @@ (setf (storage-element window :local +session-key+) (jonathan:to-json val))) (defun session-user (clog-obj) - (user-with-key (session-key (window (connection-body clog-obj))))) + (when-let (obj (object-with-key (session-key (window (connection-body clog-obj))))) + (when (typep obj 'session) + (user obj)))) (defun cur-playlist-ctl (obj) (connection-data-item obj +playlist-connection-key+)) @@ -7,6 +7,7 @@ (defclass/std user-ctl () ()) + ;;; CLIENT CONTROL ;;; CLIENT UI diff --git a/utilities.lisp b/utilities.lisp index d36c4db..ec1ae55 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -13,6 +13,16 @@ host (get-universal-time)))))) +(defun hash-string (plaintext salt) + "Hash plaintext using SALT" + (flexi-streams:octets-to-string + (ironclad:digest-sequence + :sha3 + (flexi-streams:string-to-octets (concatenate 'string salt plaintext) + :external-format :utf-8)) + :external-format :latin1)) + + (defun default-name (kind) (format nil "~a" (gensym kind))) diff --git a/vampire.asd b/vampire.asd index 932c7d0..87e187f 100644 --- a/vampire.asd +++ b/vampire.asd @@ -19,6 +19,7 @@ (:file "downloader") (:file "model") (:file "session") + (:file "login") (:file "user") (:file "playlist") (:file "vampire"))) diff --git a/vampire.lisp b/vampire.lisp index e089b0d..f99d5a3 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -70,20 +70,6 @@ (setf (url (location (connection-body parent))) url))))))) -(defun login-page (body) - (with-clog-create body - (div () - (p (:content "LOGIN")) - (form-element (:text :bind name)) - (button (:bind btn :content "Click here to log in"))) - (set-on-click - btn - (lambda (obj) - (declare (ignore obj)) - (let ((u (new-user :name (value name)))) - (setf (session-key (window body)) (key u)) - (setf (url (location body)) "/")))))) - (defun main (body) (if (session-user body) (setf (url (location body)) "/home") |