Posting edit/close/delete

data.lisp

@@ -47,7 +47,7 @@ be reconnected. Returns boolean on whether the global *database* is now connecte
 
 (defclass raw ()
   ((id :col-type serial :reader raw-id)
-   (crearsigned :col-type string :initarg :clearsigned)
+   (clearsigned :col-type string :initarg :clearsigned)
    (fingerprint :col-type string :reader raw-fingerprint :initarg :fingerprint)
    (timestamp :col-type timestamptz :initarg :timestamp)
    (created-on :col-type timestamptz :col-default (:now))
@@ -72,3 +72,6 @@ be reconnected. Returns boolean on whether the global *database* is now connecte
   (!dao-def)
   (!foreign 'posting :posting-id :primary-key)
   (!foreign 'raw :raw-id :primary-key))
+
+(defun posting-deletedp (posting)
+  (equal (posting-status posting) "deleted"))

engine.lisp

@@ -3,7 +3,10 @@
   (:use :cl :assboard.utils)
   (:export #:command-error
            #:process-command
-           #:format-new-posting))
+           #:format-new-posting
+           #:format-update-posting
+           #:format-close-posting
+           #:format-delete-posting))
 (in-package #:assboard.engine)
 
 (defvar *posting-hash-salt* "[TEST]" "Key for HMAC for new post to get id-hash")
@@ -27,6 +30,7 @@
 (define-condition not-valid-command-error (command-error) ())
 (define-condition not-valid-signature-error (command-error) ())
 (define-condition not-valid-timestamp-error (command-error) ())
+(define-condition not-valid-hash-error (command-error) ())
 
 (defun get-post-hash (body author)
   "Get part of body+author HMAC to use id-hash."
@@ -40,12 +44,15 @@
              (crypto:hmac-digest hmac) :uri t)
             0 *posting-hash-length*)))
 
+(defun get-author (raw)
+  (let ((fgp (data::raw-fingerprint raw)))
+    (or (cdr (assoc fgp
+                    assboard.wot:*trustlist-cache*
+                    :test #'equal))
+        fgp)))
+
 (defun cmd/new-post (cmd raw)
-  (let* ((fgp (assboard.data::raw-fingerprint raw))
-         (author (or (cdr (assoc fgp
-                                 assboard.wot:*trustlist-cache*
-                                 :test #'equal))
-                     fgp))
+  (let* ((author (get-author raw))
          (title-end (position #\Newline cmd))
          (title (subseq cmd 10 title-end))
          (body (subseq cmd (+ title-end 2)))
@@ -64,17 +71,75 @@
                          :raw-id (data::raw-id raw))))
     (values posting posting-edition)))
 
+(defun find-users-posting (hash author)
+  (first (pomo:select-dao
+          'data::posting
+          (:and
+           (:= 'hash hash)
+           (:= 'author author)))))
+
+(defun cmd/update-post (cmd raw)
+  (let* ((author (get-author raw))
+         (hash-end (position #\Colon cmd))
+         (hash (subseq cmd 12 hash-end))
+         (posting (find-users-posting hash author)))
+    (unless posting
+      (error 'not-valid-hash-error))
+    (let* ((title-end (position #\Newline cmd))
+           (title (subseq cmd (+ hash-end 2) title-end))
+           (body (subseq cmd (+ title-end 2)))
+           (posting-edition
+            (pomo:make-dao 'data::posting-edition
+                           :posting-id (data::posting-id posting)
+                           :title title
+                           :body body
+                           :raw-id (data::raw-id raw))))
+      (setf (data::posting-title posting) title
+            (data::posting-body posting) body
+            (data::posting-status posting) "open"
+            (data::posting-updated-on posting) (local-time:now))
+      (pomo::save-dao posting)
+      (values posting posting-edition))))
+
+(defun cmd/close-post (cmd raw)
+  (let* ((hash-end (position #\Newline cmd))
+         (hash (subseq cmd 11 hash-end))
+         (posting (find-users-posting hash (get-author raw))))
+    (unless posting
+      (error 'not-valid-hash-error))
+    (setf (data::posting-status posting) "closed"
+          (data::posting-updated-on posting) (local-time:now))
+    (pomo::save-dao posting)
+    (values posting nil)))
+
+(defun cmd/delete-post (cmd raw)
+  (let* ((hash-end (position #\Newline cmd))
+         (hash (subseq cmd 12 hash-end))
+         (posting (find-users-posting hash (get-author raw))))
+    (unless posting
+      (error 'not-valid-hash-error))
+    (setf (data::posting-status posting) "deleted"
+          (data::posting-updated-on posting) (local-time:now))
+    (pomo::save-dao posting)
+    (values posting nil)))
+
 (defun format-new-posting (title body)
   (format nil "NEW POST: ~A~%~%~A" title body))
 
-(defun cmd/close-post (cmd raw))
+(defun format-update-posting (post title body)
+  (format nil "UPDATE POST ~A: ~A~%~%~A" (data::posting-hash post) title body))
+
+(defun format-close-posting (post)
+  (format nil "CLOSE POST ~A" (data::posting-hash post)))
 
-(defun cmd/update-post (cmd raw))
+(defun format-delete-posting (post)
+  (format nil "DELETE POST ~A" (data::posting-hash post)))
 
 (defparameter +commands+
   (list (cons "NEW POST: " #'cmd/new-post)
-        (cons "CLOSE POST: " #'cmd/close-post)
-        (cons "UPDATE POST: " #'cmd/update-post)))
+        (cons "CLOSE POST " #'cmd/close-post)
+        (cons "UPDATE POST " #'cmd/update-post)
+        (cons "DELETE POST " #'cmd/delete-post)))
 
 (defun get-command-handler (command)
   (cdr (find command +commands+ :key #'car

web.lisp

@@ -48,7 +48,7 @@
                                       object)))
     (finalize-page full-data)))
 
-(defun posts-list (out posts)
+(defun posts-list (out posts &key (author t) (status nil))
   (who:with-html-output (out)
     (if posts
         (who:htm
@@ -57,11 +57,16 @@
              :do (who:htm
                   (:li
                    (:a :href (restas:genurl 'posting :hash (data::posting-hash post))
-                       (who:str (data::posting-title post)))
-                   " by "
-                   (:a :href (restas:genurl 'author
-                                            :author (data::posting-author post))
-                       (who:str (data::posting-author 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))
@@ -81,7 +86,8 @@
   (pomo:query-dao
    'data::posting
    (:select 'hash 'author 'status 'title 'maintainer 'created-on
-            :from 'posting)))
+            :from 'posting
+            :where (:= 'status "open"))))
 
 (defmethod render-route-data ((route (eql 'posting/post)) (data list))
   (list
@@ -123,30 +129,118 @@
    :content
    (who:with-html-output-to-string (out)
      (:h1 (who:str (getf data :author)) "'s postings")
-     (who:str (posts-list out (getf data :posts))))))
+     (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 (:= 'author author)))))
+                         :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))
-  (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:str (data::posting-title object)))
-      (:div (cl-markdown:markdown (data::posting-body object) :stream out))))))
+  (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 (:= 'hash 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+)))