diff of c6be55edd3bd41a6980a915a9bc8abcf829bfad4
c6be55edd3bd41a6980a915a9bc8abcf829bfad4
diff --git a/resources/css/murja.css b/resources/css/murja.css
index 99de617..b09d7fa 100644
--- a/resources/css/murja.css
+++ b/resources/css/murja.css
@@ -465,6 +465,20 @@ input:required {
background-color: #880088;
}
+.editor-saver {
+ display: flex;
+ flex-direction: column;
+ justify-content: center;
+}
+
+.editor-saver > input {
+ padding: 10px;
+}
+
+#article {
+ display: none;
+}
+
@media only screen and (max-device-width:480px)
{
body {
diff --git a/src/middleware/auth.lisp b/src/middleware/auth.lisp
index 9c74ebe..6dc4b81 100644
--- a/src/middleware/auth.lisp
+++ b/src/middleware/auth.lisp
@@ -123,7 +123,7 @@
(funcall next)))))
(progn (format t "löydetäänköhän me ~a~%" user-id)
(if user-id
- (let ((user (postmodern:get-dao 'murja.model.user:user user-id)))
+ (let ((user (murja.model.user:get-user user-id)))
(if (and user
(string= (hunchentoot:session-value :logged-in-username)
(user-username user)))
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
index 2894bbb..ca0c828 100644
--- a/src/middleware/db.lisp
+++ b/src/middleware/db.lisp
@@ -1,6 +1,7 @@
(defpackage murja.middleware.db
(:use :cl :postmodern)
(:export :connect-murjadb-toplevel
+ :@db
:@transaction
:with-db
:*automatic-tests-on?*))
@@ -52,6 +53,21 @@
(format t "Error from db: ~a~%" c)
(setf (hunchentoot:return-code*) 500)
(return-from @transaction "Internal Server Error"))))
- (with-transaction ()
- (let ((murja.settings:*settings* (murja.settings:get-settings)))
+ (with-transaction (:repeatable-read-rw)
+ (let* ((murja.settings:*settings* (murja.settings:get-settings)))
(funcall next))))))
+
+(defun @db (next)
+ (with-db
+ (handler-bind ((cl-postgres:database-socket-error
+ (lambda (c)
+ (format t "Socket error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @db "Internal Server Error")))
+ (cl-postgres:database-error
+ (lambda (c)
+ (format t "Error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @db "Internal Server Error"))))
+ (let* ((murja.settings:*settings* (murja.settings:get-settings)))
+ (funcall next)))))
diff --git a/src/model/post.lisp b/src/model/post.lisp
index 9ad4021..615f544 100644
--- a/src/model/post.lisp
+++ b/src/model/post.lisp
@@ -10,13 +10,13 @@
;; fuck it we're moving from hashmaps to clos now
(defclass Post ()
;; slots are copied from the table blog.Post, accessors are what I might call these were I designing the db nowadays
- ((id :initarg :id :accessor post-id :initform nil :col-type integer)
+ ((id :initarg :id :accessor post-id :col-type integer)
(title :initarg :title :accessor post-title :initform "" :col-type string)
(content :initarg :content :accessor article :initform "" :col-type string)
- (creator :initarg :creator :initform nil :accessor creator)
- (creator-id :initarg :creator-id :initform nil :col-type string :reader creator-id :col-references (murja.model.user:user 'murja.model.user::id))
- (tags :initarg :tags :accessor tags :col-type string :initform nil)
- (created-at :initarg :created-at :accessor created-at :initform nil :col-type simple-date:timestamp)
+ (creator :initarg :creator :accessor creator)
+ (creator-id :initarg :creator-id :col-type string :reader creator-id :col-references (murja.model.user:user 'murja.model.user::id))
+ (tags :initarg :tags :accessor tags :col-type string)
+ (created-at :initarg :created-at :accessor created-at :col-type simple-date:timestamp)
(hidden :initarg :hidden? :accessor post-hidden? :initform t :col-type boolean)
(unlisted :initarg :unlisted? :accessor post-unlisted? :initform nil :col-type boolean)
(previous :ghost t :initarg :previous :accessor previous-post-id :col-type integer :initform -1)
diff --git a/src/model/user.lisp b/src/model/user.lisp
index e06375b..3037975 100644
--- a/src/model/user.lisp
+++ b/src/model/user.lisp
@@ -1,7 +1,7 @@
(defpackage murja.model.user
(:use :cl)
(:local-nicknames (:json :com.inuoe.jzon))
- (:export :User :user-id :user-username :user-password :user-nickname :user-img-location :abilities))
+ (:export :get-user :User :user-id :user-username :user-password :user-nickname :user-img-location :abilities))
(in-package :murja.model.user)
diff --git a/src/view/admin/components/editor.lisp b/src/view/admin/components/editor.lisp
index f679225..ed448e0 100644
--- a/src/view/admin/components/editor.lisp
+++ b/src/view/admin/components/editor.lisp
@@ -3,7 +3,7 @@
(:export :editor)
(:import-from :murja.view.admin.components.tag-script :tags-component-frontend)
(:import-from :murja.view.admin.components.previouslies-script :previouslies-component-frontend)
- (:import-from :murja.model.post :tags :article :post-title :post-hidden? :post-unlisted?)
+ (:import-from :murja.model.post :post-id :tags :article :post-title :post-hidden? :post-unlisted?)
(:local-nicknames (:posts :murja.model.post)
(:json :com.inuoe.jzon)))
@@ -34,6 +34,7 @@
(defun tag-component (post)
(with-html
(:div.tag-component
+ (:input :type "hidden" :id "tags-value" :name "tags" :value (json:stringify (or (tags post) #())))
(:select :multiple t :class "tag-select" :id "tag-select"
(dolist (tag (tags post))
(:option :value tag tag)))
@@ -58,7 +59,9 @@
(:div.editor-top
(post-meta post)
(tag-component post)
- (previouslies post))))
+ (previouslies post)
+ (:div.editor-saver
+ (:input :type :submit :value "Save post!")))))
(defun editor-script (post)
(ps
@@ -68,15 +71,31 @@
(let ((editor (chain ace
(edit "editor-post-content"
(create theme "ace/theme/monokai"
- mode "ace/mode/html")))))
+ mode "ace/mode/html"))))
+ (form (chain document
+ (query-selector "#mainform"))))
(chain editor (set-keyboard-handler "ace/keyboard/emacs"))
- (chain editor (set-value (lisp (article post))))))))))
+ (chain editor (set-value (lisp (article post))))
+
+ (chain form
+ (add-event-listener "submit"
+ (lambda (e)
+ (let ((txt (chain document
+ (query-selector "#article")))
+ (editor (chain ace (edit "editor-post-content"))))
+ (setf (@ txt value)
+ (chain editor (get-value)))
+ e))))))))))
+
+
(defun editor (post)
(with-html
(:script (:raw (editor-script post)))
(:script (:raw (editor-dnd-script)))
- (header post)
- (:div
- (:div :id "editor-post-content"))))
+ (:form :method "POST" :action (format nil "/api/save-post/~d" (post-id post)) :id "mainform"
+ (header post)
+ (:div
+ (:textarea :name "article" :id "article")
+ (:div :id "editor-post-content")))))
diff --git a/src/view/admin/components/previouslies-script.lisp b/src/view/admin/components/previouslies-script.lisp
index df026bd..bdaea78 100644
--- a/src/view/admin/components/previouslies-script.lisp
+++ b/src/view/admin/components/previouslies-script.lisp
@@ -17,7 +17,8 @@
(defun previouslies-component-frontend ()
(ps
(defun remove-previously (id)
- (lambda ()
+ (lambda (e)
+ (chain e (prevent-default))
(let* ((previouslies-input (chain document
(query-selector "#previouslies")))
(previouslies (chain JSON (parse (@ previouslies-input value)))))
@@ -106,6 +107,7 @@
(setf (@ option value) (@ result id))
(chain option
(add-event-listener "click" (lambda (e)
+ (chain e (prevent-default))
(let* ((id (@ e target value))
(title (@ e target innerText))
(previouslies-input (chain document
@@ -130,6 +132,7 @@
(query-selector "#add-previously")
(add-event-listener "click"
(lambda (ee)
+ (chain ee (prevent-default))
(chain document
(query-selector "#previouslyModal")
(show-modal)))))
@@ -138,6 +141,7 @@
(query-selector "#closeModal")
(add-event-listener "click"
(lambda (ee)
+ (chain ee (prevent-default))
(chain document
(query-selector "#previouslyModal")
(close)))))
diff --git a/src/view/admin/components/tag-script.lisp b/src/view/admin/components/tag-script.lisp
index a85c303..b0162ed 100644
--- a/src/view/admin/components/tag-script.lisp
+++ b/src/view/admin/components/tag-script.lisp
@@ -5,8 +5,32 @@
(in-package :murja.view.admin.components.tag-script)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (named-readtables:in-readtable :murja.ps))
+
(defun tags-component-frontend ()
(ps
+
+ (defun sync-tags-input ()
+ "Syncs every option inside tag <select> into a JSON.stringified array inside the hidden tag-input.value"
+ (let ((tag-select (chain document
+ (query-selector "#tag-select")))
+ (tag-input (chain document
+ (query-selector "#tags-value")))
+ (acc (array)))
+ (dolist (node (@ tag-select child-nodes))
+ (when (= (@ node tag-name) "OPTION")
+ (chain acc (push node))))
+
+ (setf (@ tag-input value)
+ (chain JSON
+ (stringify
+ (chain acc
+ (map (lambda (node)
+ (@ node text))))))))
+ false)
+
+
(chain document
(add-event-listener "DOMContentLoaded"
(lambda (e)
@@ -19,6 +43,7 @@
(chain add-tag
(add-event-listener "click" (lambda (e)
+ (chain e (prevent-default))
(let* ((new-tag (chain
(prompt "New tag?")
(to-lower-case)))
@@ -28,10 +53,16 @@
(setf (@ as-option text) new-tag)
(chain tag-select
options
- (add as-option))))))
+ (add as-option))
+
+ (sync-tags-input)
+ false))))
(chain remove-tag
(add-event-listener "click" (lambda (e)
+ (chain e (prevent-default))
(chain
tag-select
- (remove (@ tag-select selected-index))))))))))))
+ (remove (@ tag-select selected-index)))
+ (sync-tags-input)
+ false)))))))))
diff --git a/src/view/admin/new-post.lisp b/src/view/admin/new-post.lisp
index 4973106..0108768 100644
--- a/src/view/admin/new-post.lisp
+++ b/src/view/admin/new-post.lisp
@@ -1,7 +1,13 @@
(defpackage murja.view.admin.new-post
- (:use :cl :binding-arrows :spinneret :murja.model.post :murja.view.admin.components.editor)
+ (:use :cl :easy-routes :binding-arrows :spinneret :murja.model.post :murja.view.admin.components.editor)
;; (:import-from :murja.model.post :article :post-title)
- (:import-from :murja.view.components.tabs :deftab))
+ (:import-from :murja.middleware.db :@transaction :@db)
+ (:import-from :murja.routes.login-routes :formdata->hashmap)
+ (:import-from :murja.middleware.auth :@authenticated :@ssr-authenticated :*user* :@can?)
+ (:import-from :murja.model.user :user-id )
+ (:import-from :murja.view.components.tabs :deftab)
+ (:import-from :murja.posts.post-db :insert-post)
+ (:local-nicknames (:json :com.inuoe.jzon)))
(in-package :murja.view.admin.new-post)
@@ -14,13 +20,18 @@
;; :referrerpolicy "no-referrer"
)))
-(deftab blog/new-post (:url "/blog/new-post"
- :subtab murja.view.admin.post-list:blog/postadmin
- :require-login t
- :needed-abilities ("create-post" "delete-post" "edit-post")
- :inject-to-head (#'head-script))
- (let ((new-post (make-instance 'post :content "kissa" :title "titteli")))
- (editor new-post)))
+(defroute blog/new-post ("/blog/new-post"
+ :method :post
+ :decorators (@db
+ @ssr-authenticated)) ()
+ (let ((abilities (coerce (murja.model.user:abilities *user*) 'list)))
+ (if (member "create-post" abilities :test 'equal)
+ (let ((post-id
+ ;; TODO wrap these stupid sql-wrappers with something that unbinds values automatically
+ (caar (insert-post "New post" "New title" (user-id *user*) "[]" t t))))
+ (format t "A new post with id ~d should now exist~%" post-id)
+ (redirect 'blog/post/editor :id (format nil "~d" post-id)))
+ "no can do")))
(deftab blog/post/editor (:url "/blog/post/editor/:id"
:subtab murja.view.admin.post-list:blog/postadmin
@@ -28,6 +39,32 @@
:needed-abilities ("create-post" "delete-post" "edit-post")
:inject-to-head (#'head-script)
:captured-url-params (id))
- (let ((old-post (get-post id :allow-hidden? t)))
+ (let ((old-post (get-post (parse-integer id) :allow-hidden? t)))
+ (assert old-post)
(editor old-post)))
+(defroute api/save-post ("/api/save-post/:id" :method :post
+ :decorators (@db
+ @ssr-authenticated)) ()
+ (let ((abilities (coerce (murja.model.user:abilities *user*) 'list)))
+ (when (member "edit-post" abilities :test 'equal)
+ (let ((post (get-post (parse-integer id) :allow-hidden? t))
+ (form (formdata->hashmap (hunchentoot:raw-post-data :force-text t))))
+
+ (setf (article post) (gethash "article" form))
+ (setf (post-title post) (gethash "title" form))
+ (setf (post-hidden? post) (equalp "on" (gethash "hidden" form)))
+ (setf (post-unlisted? post) (equalp "on" (gethash "unlisted" form)))
+ (setf (tags post) (gethash "tags" form))
+
+ (format t "Form: ~a~%" (alexandria:hash-table-plist form))
+
+ (format t "Post: ~a~%" post)
+
+ (postmodern:update-dao post)
+
+ (dolist (link (coerce (json:parse (gethash "previouslies" form)) 'list))
+ (let ((id (gethash "id" link)))
+ (murja.posts.post-db:link-previously (post-id post) id)))
+
+ (hunchentoot:redirect (easy-routes:genurl 'murja.view.single-post:blog/post/id :id (post-id post)))))))
diff --git a/src/view/blog-root.lisp b/src/view/blog-root.lisp
index 672b55e..6d44ff9 100644
--- a/src/view/blog-root.lisp
+++ b/src/view/blog-root.lisp
@@ -2,7 +2,8 @@
(:use :cl :binding-arrows
:murja.view.components.blogpost
:easy-routes
- :murja.settings :cl-hash-util)
+ :murja.settings :cl-hash-util)
+ (:export :root)
(:import-from :murja.view.components.tabs :deftab)
(:import-from :murja.model.post :get-page))
diff --git a/src/view/components/root.lisp b/src/view/components/root.lisp
index 2331d4f..bc70d1a 100644
--- a/src/view/components/root.lisp
+++ b/src/view/components/root.lisp
@@ -41,7 +41,8 @@
(not (member (cl-ppcre:regex-replace "/\\d+$" (hunchentoot:request-uri*) "")
disabled-routes
:test 'equal)))
- (:a :href "/blog/new-post" "NEW POST")))))
+ (:form :action "/blog/new-post" :method "post"
+ (:input :type :submit :value "NEW POST"))))))
(defun loginform/user-widget ()
diff --git a/src/view/components/tabs.lisp b/src/view/components/tabs.lisp
index 256ad60..36266f1 100644
--- a/src/view/components/tabs.lisp
+++ b/src/view/components/tabs.lisp
@@ -52,13 +52,13 @@
(let ((murja.settings:*settings* (murja.settings:get-settings)))
(with-html
,@rst)))))))
- (defroute ,(intern (format nil "~a-sym" sym)) (,url
- :method :get
- :decorators (@transaction
- (@ssr-authenticated :require-authentication ,require-login )
- ;;@check-if-initial
- (@dispatcher ,inject-to-head)
- )) ()
+ (defroute ,sym (,url
+ :method :get
+ :decorators (@transaction
+ (@ssr-authenticated :require-authentication ,require-login )
+ ;;@check-if-initial
+ (@dispatcher ,inject-to-head)
+ )) ()
(values (quote ,sym) (list ,@captured-url-params)))))
(defun tab-container (selected-tab tablist tab-parameters)
diff --git a/src/view/single-post.lisp b/src/view/single-post.lisp
index 4fd454b..a48f7f5 100644
--- a/src/view/single-post.lisp
+++ b/src/view/single-post.lisp
@@ -4,6 +4,7 @@
:murja.settings :cl-hash-util
:murja.view.components.blogpost)
(:import-from :murja.view.components.tabs :deftab)
+ (:export :blog/post/id)
(:import-from :murja.model.post :get-post))
(in-package :murja.view.single-post)