aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--login.lisp12
-rw-r--r--model.lisp10
-rw-r--r--new-account.lisp12
-rw-r--r--session.lisp4
4 files changed, 26 insertions, 12 deletions
diff --git a/login.lisp b/login.lisp
index 2e7c652..1eb3955 100644
--- a/login.lisp
+++ b/login.lisp
@@ -17,5 +17,15 @@
(:p ()
(:a (:link "/new-account" :content "Create an account")))))
(setf (place-holder name-input) "Name"
- (place-holder pw-input) "Password")))
+ (place-holder pw-input) "Password")
+ (set-on-click
+ btn
+ (thunk*
+ (let ((user
+ (login-user (value name-input) (value pw-input))))
+ (if user
+ (let ((session (make-session user)))
+ (setf (session-key (window body)) (key session)
+ (url (location body)) "/home"))
+ (alert (window body) "Error logging in.")))))))
diff --git a/model.lisp b/model.lisp
index cc87453..fc8d93f 100644
--- a/model.lisp
+++ b/model.lisp
@@ -88,11 +88,11 @@
(when (uses-remaining invite)
(decf (uses-remaining invite))
(unless (plusp (uses-remaining invite))
- (bknr.datastore:delete-object invite))
- (let ((user (make-instance 'user :name username)))
- (setf (user-pwhash user)
- (hash-string pw (user-pwsalt user)))
- user)))))
+ (bknr.datastore:delete-object invite)))
+ (let ((user (make-instance 'user :name username)))
+ (setf (user-pwhash user)
+ (hash-string pw (user-pwsalt user)))
+ user))))
(defun append-track (pl tr)
(with-transaction ()
diff --git a/new-account.lisp b/new-account.lisp
index 93cf122..b0ccae7 100644
--- a/new-account.lisp
+++ b/new-account.lisp
@@ -52,9 +52,9 @@
(set-on-click
submit
(thunk*
- (if (loop for status in (list pw-confirm-status name-status invite-status)
- always (string-equal "✔" (value status)))
- (if (use-invite-with-code (value invite) (value name) (value pw))
- (setf (url (location body)) "/login")
- (alert (window body) "An error occurred while making your account."))
- (alert (window body) "Plase double check your inputs."))))))
+ (if (loop for status in (list pw-confirm-status name-status invite-status)
+ always (string-equal "✔" (text status)))
+ (if (use-invite-with-code (value invite) (value name) (value pw))
+ (setf (url (location body)) "/login")
+ (alert (window body) "An error occurred while making your account."))
+ (alert (window body) "Plase double check your inputs."))))))
diff --git a/session.lisp b/session.lisp
index 0ad10c2..6d36bec 100644
--- a/session.lisp
+++ b/session.lisp
@@ -7,6 +7,10 @@
(defclass/bknr session (keyed)
((user :std (error "Sessions must be associated with users."))))
+(defun make-session (user)
+ (with-transaction ()
+ (make-instance 'session :user user)))
+
;;; SESSION PARAMETER KEYS
(defparameter +session-key+ "vampire-session-key"