aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--login.lisp21
-rw-r--r--model.lisp12
-rw-r--r--session.lisp11
-rw-r--r--user.lisp1
-rw-r--r--utilities.lisp10
-rw-r--r--vampire.asd1
-rw-r--r--vampire.lisp14
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")))
+
diff --git a/model.lisp b/model.lisp
index 246e27f..b88bd91 100644
--- a/model.lisp
+++ b/model.lisp
@@ -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+))
diff --git a/user.lisp b/user.lisp
index 65163b2..a18ecb3 100644
--- a/user.lisp
+++ b/user.lisp
@@ -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")