src/view/admin/new-post.lisp

DOWNLOAD
(defpackage murja.view.admin.new-post
  (: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.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)

(defun head-script ()
  (with-html
    (:script
     :src "https://cdnjs.cloudflare.com/ajax/libs/ace/1.43.3/ace.min.js"
     :integrity "sha512-BHJlu9vUXVrcxhRwbBdNv3uTsbscp8pp3LJ5z/sw9nBJUegkNlkcZnvODRgynJWhXMCsVUGZlFuzTrr5I2X3sQ=="
     :crossorigin "anonymous"
     ;; :referrerpolicy "no-referrer"
     )))

(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
			  :require-login t
			  :needed-abilities ("create-post" "delete-post" "edit-post")
			  :inject-to-head (#'head-script)
			  :captured-url-params (id))
  (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)))

	(if (post-hidden? post)
	    (hunchentoot:redirect (easy-routes:genurl 'murja.view.blog-root:root))
	    (hunchentoot:redirect (easy-routes:genurl 'murja.view.single-post:blog/post/id :id (post-id post))))))))