New subsite: Book Marx.

5 files changed, 155 insertions, 6 deletions

diff --git a/schema.sql b/schema.sql
index b005380..51d487e 100644
--- a/schema.sql
+++ b/schema.sql
@@ -40,5 +40,26 @@ CREATE TABLE wiki_page_revisions(
   CHECK (format IN ('mulkwiki', 'html5', 'xhtml5', 'markdown', 'textile', 'muse', 'bbcode'))
 );
 
+
+CREATE TABLE bookmarks(
+  id          SERIAL    NOT NULL,
+  owner       INTEGER,
+  date        TIMESTAMP DEFAULT now(),
+  uri         VARCHAR   NOT NULL,
+  title       VARCHAR,
+  description VARCHAR,
+  visibility  VARCHAR,
+  PRIMARY KEY(id),
+  FOREIGN KEY(owner) REFERENCES users,
+  CHECK (visibility IN ('private', 'protected', 'public'))
+);
+
+CREATE TABLE bookmark_tags(
+  bookmark INTEGER NOT NULL,
+  tag      VARCHAR NOT NULL,
+  PRIMARY KEY(bookmark, tag),
+  FOREIGN KEY(bookmark) REFERENCES bookmarks
+);
+
 ROLLBACK;
 --COMMIT;
diff --git a/src/mulk/benki/auth.clj b/src/mulk/benki/auth.clj
index e0c730d..93e106e 100644
--- a/src/mulk/benki/auth.clj
+++ b/src/mulk/benki/auth.clj
@@ -18,10 +18,6 @@
 (defonce manager (ConsumerManager.))
 
 
-(defn redirect [x]
-  {:status 302, :headers {"Location" x}, :body ""})
-
-
 (defn return-from-openid-provider []
   (let [parlist      (ParameterList. (:query-params (request/ring-request)))
         discovered   (session/get :discovered)
@@ -79,6 +75,8 @@
     )})
 
 (defpage "/login" []
+  (session/flash-put! (or (session/flash-get)
+                          (get-in (request/ring-request) [:headers "Referer"])))
   (layout login-page-layout "Benki Login"
     [:form {:action (resolve-uri "/login/authenticate"),
             :method "GET"
diff --git a/src/mulk/benki/book_marx.clj b/src/mulk/benki/book_marx.clj
new file mode 100644
index 0000000..bf574d4
--- /dev/null
+++ b/src/mulk/benki/book_marx.clj
@@ -0,0 +1,124 @@
+(ns mulk.benki.book_marx
+  (:refer-clojure)
+  (:use [clojure         repl]
+        [hiccup core     page-helpers]
+        [clojureql       predicates]
+        [clojure.core.match :only [match]]
+        noir.core
+        [mulk.benki util db auth])
+  (:require [clojure.algo.monads  :as m]
+            [clojure.java.jdbc    :as sql]
+            [clojure.string       :as string]
+            [clojureql.core       :as cq]
+            [noir.request         :as request]
+            [noir.session         :as session])
+  (:import [org.jsoup.Jsoup]))
+
+(def bookmark_tags (cq/table :bookmark_tags))
+(def bookmarks     (cq/table :bookmarks))
+(def tags          (cq/table :tags))
+(def users         (cq/table :users))
+
+
+(def bookmarx-list-page {})
+(def bookmarx-submission-page {})
+
+(defn restrict-visibility [table user]
+  (if user
+    (cq/select table
+               (cq/where (or (=* :visibility "public")
+                             (=* :visibility "protected")
+                             (and (=* :visibility "private")
+                                  (=* :owner      user)))))
+    (cq/select table
+               (cq/where (=* :visibility "public")))))
+
+
+(defpage "/marx" {}
+  (let [user (session/get :user)
+        marks (-> bookmarks
+                  (cq/join users (=* :bookmarks.owner :users.id))
+                  (restrict-visibility (session/get :user))
+                  (cq/sort [:date#desc]))]
+    (with-dbt
+      (layout bookmarx-list-page "Book Marx"
+        [:p
+         ;;(.toString marks)
+         [:ul {:class "bookmarx-list"}
+          (for [mark @marks]
+            [:li {:class "bookmark"}
+             [:h2 {:class "bookmark-title"}
+              [:a {:href (:uri mark)}
+               (:title mark)]]
+             [:p {:class "bookmark-date"}
+              (:date mark)]
+             [:p {:class "bookmark-description"}
+              (:description mark)]])]]))))
+
+(defmacro ignore-errors [& body]
+  `(try (do ~@body)
+     (catch java.lang.Exception e#
+       nil)))
+
+(defpage [:get "/marx/submit"] {uri :uri, description :description, origin :origin}
+  (with-auth
+    (let [title (m/domonad m/maybe-m
+                  ;; FIXME: Using slurp here is a potential security problem
+                  ;; because it permits access to internal resources!
+                  [:when  uri
+                   :when  (or (.startsWith uri "http://")
+                              (.startsWith uri "https://"))
+                   soup   (ignore-errors (slurp uri))
+                   page   (org.jsoup.Jsoup/parse soup)
+                   title  (.select page "title")]
+                  (.text title))
+          origin (or origin (get-in (request/ring-request) [:headers "Referer"]))]
+      (layout bookmarx-submission-page "Submit New Bookmark"
+        [:form {:method "POST"}
+         [:table
+          [:tr [:td "URI: "]         [:td [:input {:type "text", :name "uri", :size 100, :value uri}]]]
+          [:tr [:td "Title: "]       [:td [:input {:type "text", :name "title", :size 100, :value title}]]]
+          [:tr [:td "Description: "] [:td [:textarea {:name "description", :rows 25, :cols 100}]]]
+          [:tr [:td "Tags: "]        [:td [:input {:type "text", :name "tags", :size 100, :id "bookmark-tags-field"}]]]
+          [:tr
+           [:td "Visibility: "]
+           [:td
+            [:input {:type "radio", :name "visibility", :value "private"}
+             "Private"]
+            [:input {:type "radio", :name "visibility", :value "protected",
+                     :checked "checked"}
+             "Semi-private"]
+            [:input {:type "radio", :name "visibility", :value "public"}
+             "Public"]]]]
+         [:input {:type "hidden", :name "origin", :value origin}]
+         [:input {:type "submit"}]]))))
+
+(defpage [:post "/marx/submit"] {uri :uri, description :description,
+                                 title :title, tags :tags, visibility :visibility,
+                                 origin :origin}
+  (with-auth
+    (let [tagseq (map string/trim (string/split tags #","))
+          user   (session/get :user)]
+      (with-dbt
+        (let [bookmark (sql/with-query-results
+                         results
+                         ["INSERT INTO bookmarks (owner, uri, title, description,
+                                                  visibility)
+                              VALUES (?, ?, ?, ?, ?)
+                           RETURNING id"
+                          user uri title description visibility]
+                         (:id (first (into () results))))]
+          (doseq [tag tagseq]
+            (sql/insert-values :bookmark_tags [:bookmark :tag] [bookmark tag]))))))
+  (if (and origin (not= origin ""))
+    (redirect origin)
+    (redirect (link :marx))))
+
+
+;; (defpage "/users/:id/marx" {user :id}
+;;   (let [user (session/get :user)
+;;         marks (-> bookmarks
+;;                   (cq/join users (cqp/=* :tags.owner user))
+;;                   (sort [:date#desc]))]
+;;     (with-dbt
+;;       @marks)))
diff --git a/src/mulk/benki/main.clj b/src/mulk/benki/main.clj
index 9076104..5367068 100644
--- a/src/mulk/benki/main.clj
+++ b/src/mulk/benki/main.clj
@@ -5,7 +5,7 @@
         [hiccup core     page-helpers]
         [mulk.benki      util config])
   (:require [noir server options]
-            [mulk.benki wiki auth]
+            [mulk.benki wiki auth book_marx]
             [ring.middleware.file]
             [noir.session      :as session]))
 
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 5c7cd97..d61eca4 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -41,7 +41,10 @@
 
 (defn link [& args]
   (match [(vec args)]
-    [[:wiki title & xs]] (fresolve "/wiki/~a~@[~a~]" title (first xs))))
+    [[:login]]           (fresolve "/login")
+    [[:marx]]            (fresolve "/marx")
+    [[:wiki title & xs]] (fresolve "/wiki/~a~@[~a~]" title (first xs))
+    ))
 
 (defn call-with-auth [thunk]
   (if (session/get :user)
@@ -51,3 +54,6 @@
 
 (defmacro with-auth [& body]
   `(call-with-auth (fn [] ~@body)))
+
+(defn redirect [x]
+  {:status 302, :headers {"Location" x}, :body ""})