From 75926d0ed50473efc106fa83231c862063d0f0c3 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Thu, 27 Oct 2022 13:13:21 -0500
Subject: Add: logging in with pw

---
 login.lisp       | 12 +++++++++++-
 model.lisp       | 10 +++++-----
 new-account.lisp | 12 ++++++------
 session.lisp     |  4 ++++
 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"
-- 
cgit v1.2.3