assboard/web.lisp

(in-package :cl-user)

(restas:define-module #:assboard.web
  (:use :cl :hunchentoot :assboard.utils :assboard.engine))

(in-package #:assboard.web)

;; Parameters
(setf (who:html-mode) :html5)

(restas:define-route static/css ("css/:file" :content-type "text/css")
  (let ((css-path (merge-pathnames "css/" +project-path+)))
    (merge-pathnames file css-path)))


(defclass renderer () ())
(restas::register-pkgmodule-traits
 'assboard.web
 :render-method (lambda () (make-instance 'assboard.web::renderer)))

;; Rendering
(defgeneric finalize-page (data)
  (:documentation "Final rendering step"))
(defgeneric render-route-data (route data)
  (:documentation "Process route-specific data"))

(defmethod finalize-page ((data list))
  (who:with-html-output-to-string (out nil :prologue t)
    (:html
     (:head
      (:meta :charset "utf-8")
      (:meta :http-equiv "X-UA-Compatible" :content "IE=edge")
      (:meta :name "viewport" :content "width=device-width, initial-scale=1")
      (:title (who:str (getf data :title)))
      ;;(:link :rel "stylesheet" :href (restas:genurl 'static/css :file "styles.css"))
      )
     (:body
      (who:str (getf data :menu))
      (who:str (getf data :content))))))

(defmethod render-route-data (route (data list))
  (list*
   :title (getf data :title "AssBoard")
   data))

(defmethod restas:render-object ((designer renderer) (object list))
  (let ((full-data (render-route-data (restas:route-symbol restas:*route*)
                                      object)))
    (finalize-page full-data)))

(defun posts-list (out posts &key (author t) (status nil))
  (who:with-html-output (out)
    (if posts
        (who:htm
         (:ul
          (loop for post in posts
             :do (who:htm
                  (:li
                   (:a :href (restas:genurl 'posting :hash (data::posting-hash post))
                       (who:esc (data::posting-title post)))
                   (when status
                     (who:fmt
                      " [~A]" (data::posting-status post)))
                   (when author
                     (who:htm
                      " by "
                      (:a :href (restas:genurl 'author
                                               :author (data::posting-author post))
                          (who:esc (data::posting-author post))))))))))
        (who:htm (:ul (:li "No posts yet"))))))

(defmethod render-route-data ((route (eql 'index)) (posts list))
  (list
   :title "AssBoard"
   :content
   (who:with-html-output-to-string (out)
     (:h1 "AssBoard open postings")
     (posts-list out posts)
     (:h2 "Add new posting")
     (:form :method "POST" :action (restas:genurl 'posting/post)
            (:input :type "text" :name "title" :placeholder "Title") (:br) (:br)
            (:textarea :name "body" :cols 80 :rows 10 :placeholder "Body") (:br)
            (:button :type "submit" "Prepare")))))

(restas:define-route index ("")
  (pomo:query-dao
   'data::posting
   (:select 'hash 'author 'status 'title 'maintainer 'created-on
            :from 'posting
            :where (:= 'status "open"))))

(defmethod render-route-data ((route (eql 'posting/post)) (data list))
  (list
   :title "Add new posting"
   :content
   (who:with-html-output-to-string (out)
     (:h1 "Add new posting")
     (if (getf data :error)
         (who:htm (:h2 "Error adding post:")
                  (:p (who:str (getf data :error))))
         (who:htm
          (:p "To add new posting, clearsign (`gpg --clearsign`) the following text and paste results from '-----BEGIN PGP SIGNED MESSAGE-----' up to '-----END PGP SIGNATURE-----'")
          (:textarea :disabled t :cols 80 :rows 10
                     (who:str (getf data :to-sign)))
          (:form :method "POST"
                 (:textarea :name "clearsigned" :cols 80 :rows 20 :placeholder "clearsigned") (:br)
                 (:button :type "submit" "Post")))))))

(restas:define-route posting/post ("posting/" :method :post)
  (let ((clearsigned (hunchentoot:post-parameter "clearsigned")))
    (if clearsigned
        (handler-case
            (let ((posting (process-command clearsigned)))
              (restas:redirect 'posting :hash (data::posting-hash posting)))
          (command-error (err)
            (log:info "Error processing command ~A" err)
            (list :error err
                  :clearsigned clearsigned)))
        (let ((title (hunchentoot:post-parameter "title"))
              (body (hunchentoot:post-parameter "body")))
          (if (or (equal title "") (equal body ""))
              (restas:redirect 'index)
              (list
               :to-sign (format-new-posting title body)))))))

(defmethod render-route-data ((route (eql 'author)) (data list))
  (list
   :title (format nil "~A's postings @ AssBoard" (getf data :author))
   :content
   (who:with-html-output-to-string (out)
     (:h1 (who:str (getf data :author)) "'s postings")
     (who:str (posts-list out (getf data :posts) :author nil :status t)))))

(restas:define-route author ("author/:author/")
  (let ((posts (pomo:query-dao
                'data::posting
                (:select 'hash 'author 'status 'title 'maintainer 'created-on
                         :from 'posting
                         :where (:and
                                 (:= 'author author)
                                 (:!= 'status "deleted"))))))
    (if posts
        (list :author author :posts posts)
        hunchentoot:+HTTP-NOT-FOUND+)))

(defun render/post-subheader (out post)
  (who:with-html-output (out)
    (:h2
     "by "
     (:a :href (restas:genurl 'author :author (data::posting-author post))
         (who:esc (data::posting-author post)))
     (who:fmt " [~A]" (data::posting-status post)))))

(defmethod restas:render-object ((designer renderer) (object data::posting))
  (if (data::posting-deletedp object)
      (finalize-page
       (list
        :title "Posting deleted"
        :content (who:with-html-output-to-string (out)
                   (:h1 "Posting deleted")))
       )
      (finalize-page
       (list
        :title (format nil "~A by ~A @ AssBoard"
                       (data::posting-title object)
                       (data::posting-author object))
        :content
        (who:with-html-output-to-string (out)
          (:h1 (who:esc (data::posting-title object)))
          (render/post-subheader out object)
          (:div (cl-markdown:markdown (data::posting-body object) :stream out))
          (:hr)
          (:h2 "Edit post")
          (:form :method "POST" :action (restas:genurl 'posting-edit/post
                                                       :hash (data::posting-hash object))
                 (:input :type "text" :name "title" :size 80
                         :value (data::posting-title object))
                 (:br) (:br)
                 (:textarea
                  :name "body" :cols 80 :rows 10
                  (who:esc (data::posting-body object))) (:br)
                  (:input :type "submit" :name "action" :value "Update") " "
                  (:input :type "submit" :name "action" :value "Delete") " "
                  (:input :type "submit" :name "action" :value "Close")))))))

(restas:define-route posting ("posting/:hash/")
  (let ((post (first (pomo:select-dao 'data::posting
                                      (:and
                                       (:= 'hash hash))))))
    (if post post
        hunchentoot:+HTTP-NOT-FOUND+)))

(defmethod render-route-data ((route (eql 'posting-edit/post)) (data list))
  (let ((post (getf data :post)))
    (list
     :title (format nil "Update '~A' by ~A @ AssBoard"
                    (data::posting-title post)
                    (data::posting-author post))
     :content
     (who:with-html-output-to-string (out)
       (:h1 (who:esc (format nil "Update '~A'" (data::posting-title post))))
       (render/post-subheader out post)
       (if (getf data :error)
           (who:htm (:h2 "Error editing post:")
                    (:p (who:str (getf data :error))))
           (who:htm
            (:p (who:esc (format nil "To ~a posting, clearsign (`gpg --clearsign`) the following text and paste results from '-----BEGIN PGP SIGNED MESSAGE-----' up to '-----END PGP SIGNATURE-----'"
                                 (getf data :action))))
            (:textarea :disabled t :cols 80 :rows 10
                       (who:str (getf data :to-sign)))
            (:form :method "POST"
                   (:input :type "hidden" :name "action" :value (getf data :action))
                   (:textarea :name "clearsigned" :cols 80 :rows 20 :placeholder "clearsigned") (:br)
                   (:button :type "submit" "Perform"))))))))

(restas:define-route posting-edit/post ("posting/:hash/" :method :post)
  (let ((post (first (pomo:select-dao 'data::posting (:= 'hash hash))))
        (clearsigned (hunchentoot:post-parameter "clearsigned"))
        (action (hunchentoot:post-parameter "action")))
    (if post
        (if clearsigned
            (handler-case
                (let ((posting (process-command clearsigned)))
                  (restas:redirect 'posting :hash (data::posting-hash posting)))
              (command-error (err)
                (log:warn "Error processing command ~A" err)
                (list :error err
                      :post post
                      :action action
                      :clearsigned clearsigned)))
            (let ((title (hunchentoot:post-parameter "title"))
                  (body (hunchentoot:post-parameter "body")))
              (if (and (equal action "Edit")
                       (or (equal title "") (equal body "")))
                  (restas:redirect 'posting :hash hash)
                  (list
                   :post post
                   :action action
                   :to-sign (cond
                              ((equal action "Update")
                               (format-update-posting post title body))
                              ((equal action "Close")
                               (format-close-posting post))
                              ((equal action "Delete")
                               (format-delete-posting post)))))))
        hunchentoot:+HTTP-NOT-FOUND+)))