diff of 3e82ea608b9c5b896385d20aecb01239c25e20b8
3e82ea608b9c5b896385d20aecb01239c25e20b8
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 56bc25c..9a9cc81 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -60,7 +60,7 @@
(:file "media-routes")
(:file "rss-routes")
(:file "rss-reader-routes")
- (:file "user-editor")
+ (:file "user-editor-new")
(:file "root-routes")
(:file "root-component")
(:file "tabs-component")
@@ -143,7 +143,8 @@
(:file "new-post")
(:file "logs")))
(:file "rss")
- (:file "settings")))
+ (:file "settings")
+ (:file "user-editor")))
(:file "main"))))
:build-operation program-op
:build-pathname "murja"
diff --git a/src/genurl.lisp b/src/genurl.lisp
index 99c46a9..fd80cac 100644
--- a/src/genurl.lisp
+++ b/src/genurl.lisp
@@ -34,7 +34,13 @@ THIS FUNCTION RETURNS LISTS TO PASS INTO (ps:lisp)"
(read-from-string (str:replace-all "SPLIT_FOR_" "" part)) "/")
(format nil "~a/"
part)))
- (str:split "/" url))))))
- (if (equalp (alexandria:last-elt body) "/")
+ (str:split "/" url)))))
+ (last-element (alexandria:last-elt body)))
+
+ (if (equalp last-element "/")
(butlast body)
- body))))
+ ;; remove the last / from the last element if it exists
+ (progn
+ (setf (alexandria:last-elt body)
+ (cl-ppcre:regex-replace-all "/+$" last-element ""))
+ body)))))
diff --git a/src/packages/auth.lisp b/src/packages/auth.lisp
index bff8555..ba15705 100644
--- a/src/packages/auth.lisp
+++ b/src/packages/auth.lisp
@@ -2,5 +2,5 @@
(:use :cl :postmodern)
(:import-from :murja.model.user :user-username)
(:local-nicknames (:users :murja.model.user))
- (:export :@ssr-authenticated :*now* :*session-key* :*user* :@can?))
+ (:export :@ssr-authenticated :@authenticated :*now* :*session-key* :*user* :@can?))
diff --git a/src/packages/media-db.lisp b/src/packages/media-db.lisp
index 07f846f..4a35967 100644
--- a/src/packages/media-db.lisp
+++ b/src/packages/media-db.lisp
@@ -3,4 +3,4 @@
(:import-from :com.inuoe.jzon :parse)
(:import-from :halisql :defqueries)
(:import-from :lisp-fixup :fix-timestamp)
- (:export :get-media :insert-media :select-referencing-posts*))
+ (:export :delete-picture* :get-media :insert-media :select-referencing-posts*))
diff --git a/src/packages/media-routes.lisp b/src/packages/media-routes.lisp
index 7598cfe..1484485 100644
--- a/src/packages/media-routes.lisp
+++ b/src/packages/media-routes.lisp
@@ -3,8 +3,8 @@
(:import-from :lisp-fixup :slurp-bytes)
(:import-from :com.inuoe.jzon :stringify :parse)
(:import-from :murja.middleware.db :@transaction)
- (:import-from :murja.media.media-db :get-media :insert-media)
- (:import-from :murja.middleware.auth :@can? :*user*)
+ (:import-from :murja.media.media-db :delete-picture* :get-media :insert-media)
+ (:import-from :murja.middleware.auth :@authenticated :@can? :*user*)
(:import-from :easy-routes :defroute)
diff --git a/src/packages/root-component.lisp b/src/packages/root-component.lisp
index b870759..4dadc6f 100644
--- a/src/packages/root-component.lisp
+++ b/src/packages/root-component.lisp
@@ -1,8 +1,9 @@
(defpackage :murja.view.components.root
(:use :cl :spinneret :binding-arrows
:murja.setting-definitions
- :murja.middleware.auth
+ :murja.middleware.auth
:murja.model.user)
+ (:local-nicknames (:user-editor :murja.view.user-editor))
(:export :*inject-to-head* :*inject-to-sidebar* :root-component)
(:import-from :murja.posts.post-db :get-titles-by-year))
diff --git a/src/packages/user-editor-new.lisp b/src/packages/user-editor-new.lisp
new file mode 100644
index 0000000..90353d6
--- /dev/null
+++ b/src/packages/user-editor-new.lisp
@@ -0,0 +1,10 @@
+(defpackage :murja.view.user-editor
+ (:use :cl :binding-arrows :spinneret :ps :paren-async)
+ (:local-nicknames (:auth :murja.middleware.auth)
+ (:user :murja.model.user))
+ (:import-from :murja.view.components.tabs :deftab)
+ (:import-from :easy-routes :defroute)
+
+ (:import-from :murja.middleware.db :@transaction :@db)
+ (:import-from :murja.media.media-db :delete-picture* :get-media :insert-media)
+ (:export :blog/usersettings))
diff --git a/src/packages/user-editor.lisp b/src/packages/user-editor.lisp
deleted file mode 100644
index 765c5df..0000000
--- a/src/packages/user-editor.lisp
+++ /dev/null
@@ -1,13 +0,0 @@
-(defpackage murja.routes.user-editor
- (:use :cl)
- (:import-from :murja.json :bind-json)
- (:import-from :cl-hash-util :with-keys :hash)
- (:import-from :lisp-fixup :sha-512)
- (:import-from :murja.middleware.db :@transaction)
- (:import-from :murja.middleware.auth :*user*)
- (:import-from :murja.media.media-db :insert-media)
- (:import-from :com.inuoe.jzon :stringify :parse)
- (:import-from :easy-routes :defroute)
-
- (:local-nicknames (:login :murja.routes.login-routes)
- (:users :murja.model.user)))
diff --git a/src/routes/user-editor.lisp b/src/routes/user-editor.lisp
deleted file mode 100644
index 209724d..0000000
--- a/src/routes/user-editor.lisp
+++ /dev/null
@@ -1,67 +0,0 @@
-(in-package :murja.routes.user-editor)
-
-;; TODO redo with spinneret
-
-;; (defun can-save-user? (user-id old-password)
-;; (and *user*
-;; (equalp (users:user-id *user*)
-;; user-id)
-;; ;; (user-db:search-with-id-and-pwd* user-id (sha-512 old-password))
-;; ))
-
-(defmacro patch (map symbol)
- (let ((symbol-str (str:downcase (format nil "~s" symbol))))
- `(setf (gethash ,symbol-str ,map) ,symbol)))
-
-;; (defroute submit-user ("/api/user/submit" :method :post
-;; :decorators (@transaction
-;; @authenticated
-;; @json)) ()
-;; (bind-json (nickname username img_location id old-password) (new-password) (hunchentoot:raw-post-data :force-text t)
-;; (if (can-save-user? id old-password)
-;; (let* ((user (user-db:get-user-by-id id)))
-;; (patch user nickname)
-;; (patch user username)
-
-;; (when (and new-password
-;; (not (string= new-password "")))
-;; (setf (gethash "password" user)
-;; (sha-512 new-password)))
-
-;; (user-db:patch-user user)
-;; (setf (hunchentoot:return-code*) 204)
-
-;; (multiple-value-bind (session-key max-age) (login:get-session-key username)
-;; (login:set-session-cookies username session-key max-age (settings:get-settings))
-;; (murja.session:set-session-value :logged-in-username username))
-
-;; "")
-
-;; (progn
-;; (log:warn "can-save-user? failed due to ~a" (cond
-;; ((not *user*) "*user* failing")
-;; ((not (equalp (gethash "id" *user*)
-;; id))
-;; (format nil "id ~a != ~a" (gethash "id" *user*)
-;; id))
-;; ((not (user-db:search-with-id-and-pwd* id (sha-512 old-password)))
-;; "password lookup failing")))
-;; (setf (hunchentoot:return-code*) 500)
-;; ""))))
-
-;; (defroute submit-profile-pic ("/api/pictures/profile" :method :post
-;; :decorators (@transaction
-;; @authenticated
-;; @json))
-;; (&post file)
-
-;; (with-keys ("id" "username") *user*
-;; (destructuring-bind (tmp-file filename mime) file
-;; (when (str:starts-with? "image/" mime)
-;; (log:info "Changing profile pic of ~a to ~a" username filename)
-;; (let* ((bytes (lisp-fixup:slurp-bytes tmp-file))
-;; (result (insert-media filename bytes))
-;; (img-id (caar result)))
-
-;; (user-db:patch-user-img* (format nil "/api/pictures/~a" img-id) id)
-;; (stringify (hash (:id img-id))))))))
diff --git a/src/view/admin/components/dnd-script.lisp b/src/view/admin/components/dnd-script.lisp
index 2b3c3da..58a5a63 100644
--- a/src/view/admin/components/dnd-script.lisp
+++ b/src/view/admin/components/dnd-script.lisp
@@ -23,7 +23,7 @@
(chain form-data
(append "file" (chain item (get-as-file)))))
- (let ((response (await (fetch (murja.genurl:route->url-ps 'murja.routes.media-routes:post-pic)
+ (let ((response (await (fetch (lisp (murja.genurl:route->url-ps 'murja.routes.media-routes:post-pic))
(create
method "POST"
body form-data)))))
diff --git a/src/view/components/root.lisp b/src/view/components/root.lisp
index fb027e3..8d8d501 100644
--- a/src/view/components/root.lisp
+++ b/src/view/components/root.lisp
@@ -45,7 +45,7 @@
(if *user*
(:p :data-testid "welcome-user-label"
;; FIXME usersettings doesn't exist
- "Welcome, " (:a :href "/blog/usersettings" (user-nickname *user*)))
+ "Welcome, " (:a :href (murja.genurl:route->url 'user-editor:blog/usersettings) (user-nickname *user*)))
(:form :method "post"
:action (murja.genurl:route->url 'murja.routes.login-routes:forms-post-login)
(:label "Username "
diff --git a/src/view/user-editor.lisp b/src/view/user-editor.lisp
new file mode 100644
index 0000000..afa87bb
--- /dev/null
+++ b/src/view/user-editor.lisp
@@ -0,0 +1,123 @@
+(in-package :murja.view.user-editor)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (named-readtables:in-readtable :murja.ps))
+
+(defroute change-profile-picture ("/api/profile-picture" :method :post
+ :decorators (@transaction
+ auth:@authenticated))
+ (&post file)
+ (destructuring-bind (tmp-file filename mime) file
+ (declare (ignore mime))
+ (let* ((bytes (lisp-fixup:slurp-bytes tmp-file))
+ (result (caar (insert-media filename bytes))))
+
+ (setf (user:user-img-location auth:*user*) (format nil "/api/pictures/~a" result))
+ (postmodern:update-dao auth:*user*)
+ result)))
+
+(defun dnd-script ()
+ (ps
+ (defun set-hover (e)
+ (chain e (prevent-default))
+ (chain (@ e target class-list)
+ (add "draggingImages")))
+
+ (defun disable-hover (e)
+ (chain e (prevent-default))
+ (chain (@ e target class-list)
+ (remove "draggingImages")))
+
+ (defun-async send-file (e)
+ (let ((form-data (new (FormData))))
+
+ (dolist (item (chain e data-transfer items))
+ (chain form-data
+ (append "file" (chain item (get-as-file)))))
+
+ (let ((response (await (fetch (lisp (murja.genurl:route->url-ps 'change-profile-picture))
+ (create
+ method "POST"
+ body form-data)))))
+ (if (= (@ response status) 200)
+ (let* ((result (await (chain response (text))))
+ ;;
+ (pic (chain document (query-selector "#usereditor-profilepic"))))
+ (setf (@ pic src) (+ "/api/pictures/" result)))
+ (alert (+ "Send failed, server responded " (@ response status) " - " (await (chain response (text)))))))))
+
+ (chain document
+ (add-event-listener "DOMContentLoaded"
+ (lambda (e)
+ (let ((container (chain document
+ (query-selector "#profile-image-container"))))
+ (chain container
+ (add-event-listener "dragenter" #'set-hover))
+
+ (chain container
+ (add-event-listener "dragover" #'set-hover))
+
+ (chain container
+ (add-event-listener "dragend" #'disable-hover))
+
+ (chain container
+ (add-event-listener "dragleave" #'disable-hover))
+
+ (chain container
+ (add-event-listener "drop" (lambda (e)
+ (chain e (prevent-default))
+ (send-file e)
+ (disable-hover e)
+ false)))))))))
+
+(defroute save-usersettings ("/usersettings" :method :post
+ :decorators (@db
+ auth:@authenticated))
+ (&post username nickname password)
+ (destructuring-bind (username nickname password) (map 'list (lambda (a)
+ (unless (string= "" a)
+ a))
+ (list username nickname password))
+ (when username
+ (setf (user:user-username auth:*user*) username))
+ (when nickname
+ (setf (user:user-nickname auth:*user*) nickname))
+ (when password
+ (setf (user:user-password auth:*user*) (lisp-fixup:sha-512 password)))
+
+ (postmodern:update-dao auth:*user*)
+ (let ((referer (hunchentoot:header-in* "referer")))
+ (hunchentoot:redirect referer))))
+
+
+(deftab blog/usersettings (:url "/usersettings"
+ :subtab t
+ :require-login t)
+ (let ((user auth:*user*))
+ (:script (:raw
+ (dnd-script)))
+
+ (:form :method :post :action (murja.genurl:route->url 'save-usersettings)
+ (:label :for "username" "Username")
+ (:input :type :text
+ :id "username"
+ :name "username"
+ :value (user:user-username user))
+
+ (:label :for "nickname" "Nickname")
+ (:input :type :text
+ :id "nickname"
+ :name "nickname"
+ :value (user:user-nickname user))
+
+ (:label :for "password" "Password")
+ (:input :type :password
+ :id "password"
+ :name "password")
+
+ (:section :id "profile-image-container"
+ (:h* (:label "Image"))
+ (:div "Drop an image file here to change your profile picture")
+ (:img.user_avatar :id "usereditor-profilepic" :src (user:user-img-location user)))
+
+ (:input :type :submit))))