diff options
Diffstat (limited to 'site')
-rw-r--r-- | site/home.lisp | 12 | ||||
-rw-r--r-- | site/login.lisp | 28 | ||||
-rw-r--r-- | site/user-known.lisp | 13 |
3 files changed, 40 insertions, 13 deletions
diff --git a/site/home.lisp b/site/home.lisp index 97c2a87..b96b52e 100644 --- a/site/home.lisp +++ b/site/home.lisp @@ -1,17 +1,5 @@ (in-package #:vampire) -(defclass user-known () - ((user :accessor user))) - -(defmethod wknd:authenticate ((req user-known)) - (or - (do> - key :when= (wknd:get-cookie +session-cookie+) - session :when= (object-with-key key) - :when (typep session 'session) - (setf (user req) (user session))) - (weekend:endpoint-redirect 'login))) - (defun home-page (user) (format nil "hey ~a" (user-name user))) diff --git a/site/login.lisp b/site/login.lisp index afbd80e..66d20ff 100644 --- a/site/login.lisp +++ b/site/login.lisp @@ -1,10 +1,36 @@ (in-package #:vampire) (defun login-page () - "login") + (with-html-string + (:div (:h1 "I vant to suck your blood") + (:form :method "POST" :action "/login" + (:input :placeholder "Name" :name "name") + (:br) + (:input :placeholder "Password" :type "password" :name "password") + (:br) + (:button :type "submit" "Click to Login"))) + (:a :href "/new-account" "Come to the Dark Side"))) (wknd:defendpoint login :get :route "login" :returns "text/html" :handle (login-page)) +(wknd:defendpoint login-user + :post :route "login" + :parameters + (name string) + (password string) + :properties + (user user) + :authenticate (authenticate-login-user name password) + :handle (wknd:endpoint-redirect 'home)) + +(defun authenticate-login-user (name password) + (do> + found-user :when= (user-with-name name) + :when (equal (user-pwhash found-user) + (hash-string password (user-pwsalt found-user))) + session := (db:with-transaction () (make-instance 'session :user found-user)) + (wknd:set-cookie +session-cookie+ :value (key session)))) + diff --git a/site/user-known.lisp b/site/user-known.lisp new file mode 100644 index 0000000..1c48c9a --- /dev/null +++ b/site/user-known.lisp @@ -0,0 +1,13 @@ +(in-package #:vampire) + +(defclass user-known () + ((user :accessor user))) + +(defmethod wknd:authenticate ((req user-known)) + (or + (do> + key :when= (wknd:get-cookie +session-cookie+) + session :when= (object-with-key key) + :when (typep session 'session) + (setf (user req) (user session))) + (weekend:endpoint-redirect 'login))) |