summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--project.clj4
-rw-r--r--schema.sql30
-rw-r--r--src/mulk/benki/lazychat.clj145
-rw-r--r--src/mulk/benki/main.clj2
-rw-r--r--src/mulk/benki/util.clj17
-rw-r--r--src/mulk/benki/webutil.clj6
-rw-r--r--static/style/hammer-and-sickle.css4
-rw-r--r--static/style/lafargue.css32
8 files changed, 236 insertions, 4 deletions
diff --git a/project.clj b/project.clj
index 1384d4e..a8bbe7f 100644
--- a/project.clj
+++ b/project.clj
@@ -40,6 +40,7 @@
[org.jsoup/jsoup "1.6.1"]
[org.apache.abdera/abdera-parser "1.1.1"]
[clj-apache-http "2.3.2"]
+ [org.pegdown/pegdown "1.1.0"]
]
:plugins [[lein-swank "1.4.3"]]
:exclusions [org.clojure/clojure-contrib] ;you know, the old pre-1.3.0 versions
@@ -62,6 +63,9 @@
;;},
"oracle"
{:url "http://download.oracle.com/maven/"
+ :snapshots false}
+ "scala-releases" ;pegdown
+ {:url "http://scala-tools.org/repo-releases"
:snapshots false}}
:source-path "src"
;;:jvm-opts ["-Xms32m"]
diff --git a/schema.sql b/schema.sql
index 49e1e63..c12f73e 100644
--- a/schema.sql
+++ b/schema.sql
@@ -85,5 +85,35 @@ CREATE TABLE bookmark_tags(
FOREIGN KEY(bookmark) REFERENCES bookmarks
);
+
+CREATE TABLE lazychat_messages(
+ id SERIAL NOT NULL,
+ author INTEGER,
+ date TIMESTAMP WITH TIME ZONE DEFAULT now(),
+ content VARCHAR,
+ visibility VARCHAR NOT NULL,
+ format VARCHAR NOT NULL,
+ PRIMARY KEY(id),
+ FOREIGN KEY(author) REFERENCES users,
+ CHECK (format IN ('markdown')),
+ CHECK (visibility IN ('personal', 'protected', 'public'))
+);
+
+CREATE TABLE lazychat_targets(
+ message INTEGER NOT NULL,
+ target INTEGER NOT NULL,
+ PRIMARY KEY(message, target),
+ FOREIGN KEY(message) REFERENCES lazychat_messages,
+ FOREIGN KEY(target) REFERENCES users
+);
+
+CREATE TABLE lazychat_references(
+ referrer INTEGER NOT NULL,
+ referee INTEGER NOT NULL,
+ PRIMARY KEY(referrer, referee),
+ FOREIGN KEY(referrer) REFERENCES lazychat_messages,
+ FOREIGN KEY(referee) REFERENCES lazychat_messages
+);
+
ROLLBACK;
--COMMIT;
diff --git a/src/mulk/benki/lazychat.clj b/src/mulk/benki/lazychat.clj
new file mode 100644
index 0000000..7546f45
--- /dev/null
+++ b/src/mulk/benki/lazychat.clj
@@ -0,0 +1,145 @@
+(ns mulk.benki.lazychat
+ (:refer-clojure)
+ (:use [clojure repl]
+ [hiccup core page-helpers]
+ [noir core]
+ [mulk.benki auth config db util webutil]
+ ;;
+ [clojure.core.match :only [match]]
+ [hiccup.core :only [escape-html]]
+ [ring.util.codec :only [url-encode]])
+ (:require [clojure.algo.monads :as m]
+ [clojure.java.jdbc :as sql]
+ [clojure.string :as string]
+ [noir.request :as request]
+ [noir.response :as response]
+ [noir.session :as session]
+ hiccup.core)
+ (:import [org.apache.abdera Abdera]))
+
+
+(defn create-lazychat-message! [{content :content, visibility :visibility
+ format :format, targets :targets,
+ referees :referees, id :id}]
+ {:pre [*user*]}
+ (with-dbt
+ (when id
+ ;; FIXME: Is this assertion sufficient? Is it too strict?
+ (assert (query1 "SELECT 't' WHERE currval('lazychat_messages_id_seq') >= ?" id)))
+ (let [id (or id
+ (:id (query1 "SELECT nextval('lazychat_messages_id_seq')::INTEGER AS id")))]
+ (sql/with-query-results ids
+ ["INSERT INTO lazychat_messages(id, author, content, format, visibility)
+ VALUES (?, ?, ?, ?, ?)
+ RETURNING id"
+ id *user* content format visibility]
+ (doseq [referee referees]
+ (sql/insert-values :lazychat_references
+ [:referrer :referee]
+ [id (int referee)]))
+ (doseq [target targets]
+ (sql/insert-values :lazychat_targets
+ [:message :target]
+ [id (int target)]))))))
+
+(defn select-message [id]
+ (let [message (query1 "SELECT author, content, format, visibility, date
+ FROM lazychat_messages
+ WHERE id = ?"
+ id)
+ referees (map :referee (query "SELECT referee FROM lazychat_references WHERE referrer = ?" id))
+ targets (map :target (query "SELECT target FROM lazychat_targets WHERE message = ?" id))]
+ (and message
+ (assoc message
+ :referees referees
+ :targets targets))))
+
+(defn may-read? [user message]
+ (or (= (:visibility message) "public")
+ (and user (= (:visibility message) "protected"))
+ (and user
+ (= (:visibility message) "personal")
+ (contains? (:targets message) user))))
+
+(defn may-post? [user]
+ user)
+
+
+(def lafargue-list-page
+ {:head (list
+ [:link {:rel "stylesheet"
+ :href (resolve-uri "/style/hammer-and-sickle.css")
+ :type "text/css"}]
+ [:link {:rel "stylesheet"
+ :href (resolve-uri "/style/lafargue.css")
+ :type "text/css"}])})
+
+(defpage "/lafargue" {}
+ (with-dbt
+ (layout lafargue-list-page "Lafargue Lazy Chat"
+ [:div {:id "login-message"
+ :class "login-message"}
+ (login-message)]
+ [:div
+ [:div {:id "lafargue-main-input-box" :class "lafargue-input-box"}
+ [:form {:method "POST" :action (link :lafargue :post)}
+ [:div [:textarea {:name "content", :rows 3, :cols 100}]]
+ [:div [:input {:type "hidden", :name "format", :value "markdown"}]]
+ [:div
+ [:input {:type "radio", :name "visibility", :value "protected" :checked "checked"} "Semi-private"]
+ [:input {:type "radio", :name "visibility", :value "public"} "Public"]]
+ [:div [:input {:type "submit"}]]]]
+ [:ul {:class "lafargue-list"}
+ (sql/with-query-results messages
+ ["SELECT m.id, m.author, m.date, m.content, m.format, u.first_name, u.last_name
+ FROM lazychat_messages m
+ JOIN users u ON (author = u.id)
+ WHERE (visibility = 'public'
+ OR (visibility = 'protected' AND (?::INTEGER) IS NOT NULL)
+ OR (visibility = 'personal'
+ AND EXISTS (SELECT *
+ FROM lazychat_targets t
+ WHERE t.target = (?::INTEGER)
+ AND message = m.id)))
+ ORDER BY m.date DESC"
+ *user* *user*]
+ (doall
+ (for [message messages]
+ [:li {:class "lafargue-message"}
+ [:h2 {:class "lafargue-message-title"}]
+ [:p {:class "lafargue-message-date-and-owner"}
+ [:span {:class "lafargue-message-date"}
+ (escape-html (format-date (:date message)))]
+ [:span {:class "lafargue-message-owner"}
+ " by " (escape-html (:first_name message))]]
+ [:div {:class "lafargue-message-body"}
+ (sanitize-html (markdown->html (:content message)))]])))]])))
+
+
+(defpage [:any "/lafargue/post"] {content :content, visibility :visibility
+ format :format, targets :targets,
+ referees :referees}
+ (with-auth
+ (create-lazychat-message! {:content content, :visibility visibility,
+ :format format, :targets targets,
+ :referees referees})
+ (redirect (referrer))))
+
+(defpage [:put "/lafargue/messages/:id"] {id :id}
+ (if (may-post? *user*)
+ (let [message (assoc (slurp (:body (request/ring-request))) :id id)]
+ (create-lazychat-message! message)
+ {:status 200})
+ {:status 403}))
+
+(defpage [:get "/lafargue/messages/:id"] {id :id}
+ (with-dbt
+ (let [message (select-message id)]
+ (if (may-read? *user* message)
+ (response/json message)
+ {:status 403}))))
+
+(defpage [:post "/lafargue/messages/genid"] {id :id}
+ (with-auth
+ (response/json
+ (with-dbt (query1 "SELECT NEXTVAL('lazychat_messages_id_seq')")))))
diff --git a/src/mulk/benki/main.clj b/src/mulk/benki/main.clj
index bdecdc1..a5e7b31 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 db])
(:require [noir server options]
- [mulk.benki wiki auth book_marx id]
+ [mulk.benki wiki auth book_marx id lazychat]
[ring.middleware.file]
[noir.session :as session]
[noir.request :as request]
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 505c637..cb0ffde 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -9,7 +9,10 @@
[clojure.java.jdbc :as sql])
(:import [java.text DateFormat]
[java.security SecureRandom]
- [java.math BigInteger]))
+ [java.math BigInteger]
+ [org.jsoup Jsoup]
+ [org.jsoup.safety Cleaner Whitelist]
+ [org.pegdown PegDownProcessor]))
(def fmt clojure.pprint/cl-format)
@@ -54,10 +57,12 @@
(defn linkrel [& args]
(match [(vec args)]
[[:login]] (fmt nil "/login")
+ [[:home]] (fmt nil "/")
[[:marx]] (fmt nil "/marx")
[[:marx :submit]] (fmt nil "/marx/submit")
[[:marx :feed]] (fmt nil "/marx/feed")
[[:marx id]] (fmt nil "/marx/~a" id)
+ [[:lafargue :post]] (fmt nil "/lafargue/post")
[[:wiki title & xs]] (fmt nil "/wiki/~a~@[~a~]" title (first xs))
))
@@ -87,3 +92,13 @@
(defn genkey []
;;(.toString (BigInteger. 260 secure-random) 32)
(BigInteger. 260 secure-random))
+
+
+;;;; * User input
+(defonce pegdown (PegDownProcessor.))
+
+(defn markdown->html [markdown]
+ (.markdownToHtml pegdown markdown))
+
+(defn sanitize-html [html]
+ (Jsoup/clean html (Whitelist/basic)))
diff --git a/src/mulk/benki/webutil.clj b/src/mulk/benki/webutil.clj
index a1a0bb5..88516e6 100644
--- a/src/mulk/benki/webutil.clj
+++ b/src/mulk/benki/webutil.clj
@@ -13,6 +13,7 @@
+;;;; * Login/authentication
(defn authlink [uri]
(with-dbt
(let [user *user*
@@ -47,3 +48,8 @@
:alt "Sign in"}]]
[:div "or:"]
[:a {:href (link :login)} "Sign in normally"]])))
+
+
+;;;; * Environment/request stuff
+(defn referrer []
+ (get-in (request/ring-request) [:headers "referer"]))
diff --git a/static/style/hammer-and-sickle.css b/static/style/hammer-and-sickle.css
index 40db121..d6b7ae6 100644
--- a/static/style/hammer-and-sickle.css
+++ b/static/style/hammer-and-sickle.css
@@ -39,7 +39,7 @@ a:active {
border-bottom: 0px solid none;
}
-ul.bookmarx-list {
+ul.bookmarx-list, ul.lafargue-list {
list-style-type: none;
}
@@ -71,7 +71,7 @@ h2 {
border: solid #bbccff;
}
-.bookmark, #content {
+.bookmark, .lafargue-message, #content {
/* border-right: 1px solid silver; */
color: inherit;
background-color: #ffbfbf;
diff --git a/static/style/lafargue.css b/static/style/lafargue.css
new file mode 100644
index 0000000..31b6a30
--- /dev/null
+++ b/static/style/lafargue.css
@@ -0,0 +1,32 @@
+.lafargue-message-date-and-owner {
+ font-style: oblique;
+ color: #555;
+ /* text-indent: 1.5em; */
+ /* margin-left: 1.5em; */
+}
+
+.lafargue-message-body {
+ margin-left: 1.5em;
+ margin-bottom: 1em;
+}
+
+#lafargue-message-footer {
+ text-align: right;
+ position: relative;
+ padding: 0.5em 0.5em 0.5em 0.5em;
+ right: 0;
+ margin: 1em;
+ font-style: oblique;
+}
+
+#lafargue-message-footer-text {
+ padding: 0.5em 1em 0.5em 1em;
+ border: solid 1px #000;
+ background-color: orange;
+}
+
+#lafargue-main-input-box {
+ margin-left:auto;
+ margin-right:auto;
+ text-align:center;
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:44:06 +0000