Modify+Add: Added pw hashing stuff to user. Add login file.

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")