diff of fb2a5fe534ad995c22563dd9368a7521a37b8d12
fb2a5fe534ad995c22563dd9368a7521a37b8d12
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index cdbdb8b..4fe8f09 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -49,6 +49,12 @@
(:module "users"
:components ((:file "user-db")))
(:file "session-db")
+
+ (:module "models"
+ :components
+ ((:file "user")
+ (:file "post")))
+
(:module "middleware"
:components ((:file "json")
(:file "db")
@@ -77,11 +83,6 @@
(:file "user-editor")
(:file "root-routes")))
- (:module "models"
- :components
- ((:file "user")
- (:file "post")))
-
(:module "views"
:components
((:module "components"
@@ -108,7 +109,8 @@
(:file "rss-tests")
(:file "session-tests")
(:file "newui-tests")
- (:file "post"))))
+ (:file "post")
+ (:file "form-parser-test"))))
:perform (test-op (op c)
(eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
diff --git a/src/middleware/auth.lisp b/src/middleware/auth.lisp
index a775cd1..286fb77 100644
--- a/src/middleware/auth.lisp
+++ b/src/middleware/auth.lisp
@@ -1,7 +1,7 @@
(defpackage murja.middleware.auth
(:use :cl :postmodern)
- (:import-from :murja.users.user-db :get-user-by-id)
- (:export :*now* :*session-key* :*user* :@can?))
+ (:import-from :murja.models.user :user-username)
+ (:export :@ssr-authenticated :*now* :*session-key* :*user* :@can?))
(in-package :murja.middleware.auth)
@@ -29,6 +29,7 @@
(log:info "populating session var from db ~a => ~a" k v)
(log:info "populating session var from db ~a" k))))))
+;; deprecated, look at @ssr-authenticated
(defun @authenticated (next &key (retries 0))
(let ((session-cookie (hunchentoot:cookie-in "murja-session"))
(username-cookie (hunchentoot:cookie-in "murja-username"))
@@ -91,3 +92,55 @@
(log:info "didn't find header x-murja-now"))
(funcall next))))
+
+
+
+(defun @ssr-authenticated (next &key (require-authentication t) (retries 0))
+ (let ((session-cookie (hunchentoot:cookie-in "murja-session"))
+ (username-cookie (hunchentoot:cookie-in "murja-username"))
+ (user-id (hunchentoot:session-value :logged-in-user-id)))
+ (when lisp-fixup:*dev?*
+ (log:info "Read session-cookie ~a for user ~a" session-cookie username-cookie))
+ (if (and (not user-id)
+ session-cookie
+ (< retries 1))
+ ;; if session-cookie is found but hunchentoot's session is expired, lets try to restore
+ ;; it from the db and retry calling this middleware function. If retries > 0 and
+ ;; restoring-from-db has failed, we're returning 401 to the caller.
+ (if (murja.session.db:assert-ownership-username username-cookie session-cookie)
+ (progn
+ (log:info "populating http-session and retrying")
+ (populate-http-session username-cookie session-cookie)
+ (@authenticated next :retries (1+ retries)))
+ (progn
+ (if require-authentication
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ (log:warn "assert-ownership-username failed for ~a" username-cookie)
+ "not authorized")
+ (progn
+ (format t "no auth required~%")
+ (funcall next)))))
+ (progn (format t "löydetäänköhän me ~a~%" user-id)
+ (if user-id
+ (let ((user (postmodern:get-dao 'murja.models.user:user user-id)))
+ (if (and user
+ (string= (hunchentoot:session-value :logged-in-username)
+ (user-username user)))
+ (let ((*user* user)
+ (*session-key* session-cookie))
+ (funcall next))
+ (if require-authentication
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ "not authorized")
+ (funcall next))))
+ (if (not require-authentication)
+ (funcall next)
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ (log:warn "failed auth at @authenticated, ~a" (list :retries retries
+ :session-cookie session-cookie
+ :username-cookie username-cookie
+ :user-id user-id))
+ "not authorized")))))))
diff --git a/src/routes/login-routes.lisp b/src/routes/login-routes.lisp
index 745d892..af1652c 100644
--- a/src/routes/login-routes.lisp
+++ b/src/routes/login-routes.lisp
@@ -1,6 +1,6 @@
(defpackage murja.routes.login-routes
- (:use :cl)
- (:export :get-session-key :set-session-cookies)
+ (:use :cl :binding-arrows)
+ (:export :get-session-key :set-session-cookies :formdata->hashmap)
(:import-from :cl-hash-util :hash)
(:import-from :murja.session :set-session-value)
(:import-from :lisp-fixup :sha-512)
@@ -118,3 +118,57 @@
(log:warn "Someone called POST /api/initial while there are users")
(setf (hunchentoot:return-code*) 500)
""))))
+
+
+
+
+
+
+
+
+
+
+
+
+;; newui login
+
+(defun formdata->hashmap (form-body)
+ (reduce (lambda (acc pair)
+ (let ((k (first pair))
+ (v (hunchentoot:url-decode (second pair))))
+ (setf (gethash k acc) v)
+ acc))
+ (->>
+ form-body
+ (str:split "&")
+ (mapcar (lisp-fixup:partial #'str:split "=")))
+
+ :initial-value (hash)))
+
+(defroute post-login ("/api/login"
+ :method :post
+ :decorators (@test-now @transaction)) ()
+ (let* ((form (formdata->hashmap (hunchentoot:raw-post-data :force-text t)))
+ (username (gethash "username" form))
+ (password (gethash "password" form))
+ (user-row (murja.users.user-db:select-user-by-login username (sha-512 password))))
+ (if (and user-row
+ (string= (gethash "username" user-row) username))
+ (let ((settings (murja.routes.settings-routes:get-settings))
+ (murja.middleware.auth:*user* (murja.users.user-db:get-user-by-id (gethash "userid" user-row))))
+ (multiple-value-bind (session-key max-age) (get-session-key username)
+ (if session-key
+ (let ((murja.middleware.auth:*session-key* session-key))
+
+ (set-session-value :logged-in-username username)
+ (set-session-value :logged-in-user-id (gethash "userid" user-row))
+
+ (set-session-cookies username session-key max-age settings)
+ (format t "Login successfully~%"))
+ (progn
+ (log:error "~a tried to log-in but get-session-key didn't return a session key. This happening signifies a bug" username)))))
+
+ (log:error "not authorized"))
+
+ (let ((referer (hunchentoot:header-in* "referer")))
+ (hunchentoot:redirect referer))))
diff --git a/src/views/blog-main.lisp b/src/views/blog-main.lisp
index a15a0e6..cea0d14 100644
--- a/src/views/blog-main.lisp
+++ b/src/views/blog-main.lisp
@@ -1,22 +1,36 @@
(defpackage murja.views.blog-main
(:use :cl :murja.views.components.root :murja.views.components.tab)
+ (:import-from :murja.models.user :user-nickname)
(:import-from :cl-hash-util :hash)
(:import-from :murja.routes.root-routes :@check-if-initial)
+ (:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
(:import-from :murja.routes.settings-routes :get-settings)
(:import-from :murja.middleware.db :@transaction)
(:import-from :murja.newui :@newui :c :with-state)
- (:import-from :easy-routes :defroute))
+ (:import-from :easy-routes :defroute)
+
+ (:export :blog-root-view))
(in-package :murja.views.blog-main)
(defroute blog-root-view ("/blog/" :method :get
- :decorators (@newui @transaction @check-if-initial)) ()
+ :decorators (@transaction
+ @newui
+ (@ssr-authenticated :require-authentication nil)
+ @check-if-initial)) ()
(let* ((settings (get-settings))
(page-size (gethash "recent-post-count" settings))
(page 1)
- (page-posts (murja.models.post:get-page page page-size)))
+ (page-posts (murja.models.post:get-page page page-size))
+
+ (tabs-spec (hash
+ ("Home" (murja.views.components.page:page page-posts)))))
+
+ (when *user*
+ (setf (gethash "Secret logged in user tab" tabs-spec)
+ (c :div () (format nil "Welcome ~a" (user-nickname *user*)))))
+
(root-component
(tabs "Home"
- (hash
- ("Home" (murja.views.components.page:page page-posts)))))))
+ tabs-spec))))
diff --git a/src/views/components/root.lisp b/src/views/components/root.lisp
index e4f3473..29dad7e 100644
--- a/src/views/components/root.lisp
+++ b/src/views/components/root.lisp
@@ -1,7 +1,9 @@
(defpackage murja.views.components.root
(:use :cl :murja.newui :binding-arrows)
+ (:import-from :murja.middleware.auth :*user*)
(:import-from :murja.posts.post-db :get-titles-by-year)
(:import-from :murja.middleware.db :*settings*)
+ (:import-from :murja.models.user :user-nickname)
(:export :root-component))
(in-package :murja.views.components.root)
@@ -28,6 +30,16 @@
(c :li () (c :a (:href (format nil "/blog/post/~d" Id)) Title))))
(gethash month by-month))))))))))))))
+(defun loginform/user-widget ()
+ (if *user*
+ (c :p (:data-testid "welcome-user-label")
+ "Welcome, " (c :a (:href "/blog/usersettings") (user-nickname *user*)))
+ (c :form (:method "post" :action "/api/login")
+ (c :label () "Username " (c :input (:id "username" :name "username" :data-testid "username-input-field")))
+ (c :label () "Password " (c :input (:id "password" :name "password" :type "password" :data-testid "password-input-field")))
+ (c :input (:type :submit :value "Log in")))))
+
+
(defun root-component (inner-component)
"Returns the root html element of murja with `inner-component` embedded inside it"
@@ -45,10 +57,7 @@
inner-component
(c :div (:id "sidebar")
- (c :form () ;; todo lol
- (c :label () "Username " (c :input (:id "username" :name "username" :data-testid "username-input-field")))
- (c :label () "Password " (c :input (:id "password" :name "password" :type "password" :data-testid "password-input-field"))))
-
+ (loginform/user-widget)
(sidebar-tree))))))
diff --git a/test/form-parser-test.lisp b/test/form-parser-test.lisp
new file mode 100644
index 0000000..d3a7a9e
--- /dev/null
+++ b/test/form-parser-test.lisp
@@ -0,0 +1,34 @@
+(defpackage murja.tests.form-parser-test
+ (:use :cl :fiveam)
+ (:import-from :murja.tests :main-suite)
+ (:import-from :murja.routes.login-routes :formdata->hashmap))
+
+(in-package :murja.tests.form-parser-test)
+
+(in-suite main-suite)
+
+(def-test form-parser-test ()
+ (let* ((easy-test "username=testi&password=testi")
+ (harder-test "username=aaaa%3Daaaa&password=heh%26%3D%3AD")
+ (hardest-test "username=testi%26&password=j%C3%A4nni%C3%A4+urli+merkkej%C3%A4%26%26%26%26"))
+
+ (let ((easy-form (formdata->hashmap easy-test)))
+ (is (string= "testi"
+ (gethash "username" easy-form)))
+ (is (string= "testi"
+ (gethash "password" easy-form))))
+
+ (let ((harder-form (formdata->hashmap harder-test)))
+ (is (string= "aaaa=aaaa"
+ (gethash "username" harder-form)))
+ (is (string= "heh&=:D"
+ (gethash "password" harder-form))))
+
+ (let ((hardest-form (formdata->hashmap hardest-test)))
+ (is (string= "testi&"
+ (gethash "username" hardest-form)))
+ (is (string= "jänniä urli merkkejä&&&&"
+ (gethash "password" hardest-form))))))
+
+;; (fiveam:explain!
+;; (fiveam:run 'form-parser-test))