Lafargue: Use web sockets to provide instantaneous updates.

4 files changed, 71 insertions, 23 deletions

diff --git a/config.sexp.sample b/config.sexp.sample
index 4353159..37bcfcf 100644
--- a/config.sexp.sample
+++ b/config.sexp.sample
@@ -1,10 +1,11 @@
 ;;;; -*- mode: clojure; coding: utf-8 -*-
 
-{:database {:classname "org.postgresql.Driver"
-            :subprotocol "postgresql"
-            :subname "//localhost:5432/benki"
-            :user "benki"
-            :password ""}
- :base-uri "http://localhost:3001"
- :tag-base "example.com"
- :web-port 3001}
+{:database       {:classname "org.postgresql.Driver"
+                  :subprotocol "postgresql"
+                  :subname "//localhost:5432/benki"
+                  :user "benki"
+                  :password ""}
+ :websocket-base "ws://localhost:3001"
+ :base-uri       "http://localhost:3001"
+ :tag-base       "example.com"
+ :web-port       3001}
diff --git a/src/mulk/benki/lazychat.clj b/src/mulk/benki/lazychat.clj
index 189b562..653475b 100644
--- a/src/mulk/benki/lazychat.clj
+++ b/src/mulk/benki/lazychat.clj
@@ -3,22 +3,30 @@
   (:use [clojure     repl]
         [hiccup      core page-helpers]
         [noir        core]
+        [noir-async  core]
         [mulk.benki  auth config db util webutil]
         ;;
         [clojure.core.match :only [match]]
         [hiccup.core        :only [escape-html]]
-        [ring.util.codec    :only [url-encode]])
+        [ring.util.codec    :only [url-encode]]
+        [lamina.core        :only [channel enqueue enqueue-and-close receive-all
+                                   map* filter*]])
   (: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)
+            hiccup.core
+            [lamina.core          :as lamina]
+            [aleph.http           :as ahttp]
+            [aleph.formats        :as aformats])
   (:import [org.apache.abdera Abdera]))
 
 
 (defonce abdera (Abdera.))
+(defonce lafargue-events (channel))
+
 
 (defn create-lazychat-message! [{content  :content,  visibility :visibility
                                  format   :format,   targets    :targets,
@@ -42,7 +50,11 @@
         (doseq [target targets]
           (sql/insert-values :lazychat_targets
                              [:message :target]
-                             [id (int target)]))))))
+                             [id (int target)]))
+        (enqueue lafargue-events
+                 {content  :content,  visibility :visibility
+                  format   :format,   targets    :targets,
+                  referees :referees, id         :id})))))
 
 (defn select-message [id]
   (let [message  (query1 "SELECT author, content, format, visibility, date
@@ -74,7 +86,9 @@
                   :type "text/css"}]
           [:link {:rel "stylesheet"
                   :href (resolve-uri "/style/lafargue.css")
-                  :type "text/css"}])})
+                  :type "text/css"}]
+          [:script {:src (resolve-uri "/js/lafargue.js")
+                    :type "text/javascript"}])})
 
 (defmacro with-messages-visible-by-user [[messages user] & body]
   `(sql/with-query-results ~messages
@@ -93,6 +107,19 @@
     ~@body))
 
 
+(defn render-message [message]
+  (html
+   [: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 "/lafargue" {}
   (with-dbt
     (layout lafargue-list-page "Lafargue Lazy Chat"
@@ -112,15 +139,7 @@
         (with-messages-visible-by-user [messages *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)))]])))
+             (render-message message))))
         [:div {:id "lafargue-footer"}
          (let [feed-link (linkrel :lafargue :feed)]
            [:span {:id "lafargue-footer-text"}
@@ -160,6 +179,24 @@
   (response/content-type "application/atom+xml; charset=UTF-8"
     (lazychat-feed-for-user *user*)))
 
+(defpage-async "/lafargue/events" {} conn
+  (if (websocket? conn)
+    (let [messages (filter* #(may-read? *user* %) lafargue-events)]
+      (receive-all messages
+                   (fn [msg]
+                     (async-push conn (render-message msg)))))
+    {:status 418}))
+
+(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 [:any "/lafargue/post"] {content  :content, visibility :visibility
                                   format   :format,  targets    :targets,
                                   referees :referees}
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 478fac3..ee53a7e 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -2,7 +2,8 @@
   (:refer-clojure)
   (:use [hiccup core page-helpers]
         [clojure.core.match :only [match]]
-        noir.core)
+        noir.core
+        [mulk.benki config])
   (:require [noir.session  :as session]
             [noir.request  :as request]
             [noir.response :as response]
@@ -35,7 +36,8 @@
 ;; defpartial is just defn + html.
 (defpartial layout [kind title & content]
   (html5 {:xml? true}
-   [:head {:data-logged-in (if *user* "true" "false")}
+   [:head {:data-logged-in      (if *user* "true" "false"),
+           :data-websocket-base (:websocket-base @benki-config)}
     [:title title]
     ;; jQuery
     [:script {:type "text/javascript"
diff --git a/static/js/lafargue.js b/static/js/lafargue.js
new file mode 100644
index 0000000..06e967d
--- /dev/null
+++ b/static/js/lafargue.js
@@ -0,0 +1,8 @@
+jQuery(function($) {
+    if (WebSocket) {
+        var socket = new WebSocket('ws://localhost:3001/lafargue/events');
+        socket.onmessage = function(event) {
+            $('.lafargue-list').prepend(event.data);
+        };
+    }
+});