Profiles / templates

1 files changed, 191 insertions, 65 deletions

diff --git a/src/site.clj b/src/site.clj
index 63e2c2a..1c43ae3 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -2,9 +2,12 @@
 
 (ns pichat
   (:import java.lang.System
+           java.text.SimpleDateFormat
+           java.util.Date
            clojure.lang.PersistentQueue
            org.apache.commons.codec.digest.DigestUtils
-           javax.servlet.http.Cookie)
+           javax.servlet.http.Cookie
+           org.antlr.stringtemplate.StringTemplateGroup)
   (:use compojure
         clojure.contrib.json.write
         clojure.contrib.sql))
@@ -18,8 +21,11 @@
            :user "postgres"
            :password "root"}))
 
+(def template-group (new StringTemplateGroup "dumpfm" "template"))
+(.setRefreshInterval template-group 3)
+
 (defstruct user-struct :user-id :nick :last-seen)
-(defstruct message-struct :nick :content :timestamp)
+(defstruct message-struct :nick :avatar :content :created_on)
 
 (def users (ref {}))
 (def messages (ref []))
@@ -28,9 +34,6 @@
 (def flusher-sleep-ms 4000)
 (def user-timeout-ms 5000)
 
-(defn swap [f]
-  (fn [& more] (apply f (reverse more))))
-
 (def flusher (agent nil))
 
 (defn flush! [x]
@@ -44,40 +47,42 @@
   (. Thread (sleep flusher-sleep-ms))
   x)
 
+;; Utils
+
+(defn encode-html-entities [s]
+  (loop [ret s
+         [[char replacement] & rest] [["&" "&"]
+                                      ["'" "'"]
+                                      ["\"" """]
+                                      ["<" "&lt;"]
+                                      [">" "&gt;"]]]
+    (if (nil? char)
+      ret
+      (recur (.replaceAll ret char replacement)
+             rest))))
+
+(defn swap [f]
+  (fn [& more] (apply f (reverse more))))
+
+(def formatter (new SimpleDateFormat "h:mm EEE M/d"))
+
+;;;;;
+
 (defn resp-error [message]
   {:status 400 :headers {} :body message})
 
 (defn resp-success [message]
   {:status 200 :headers {} :body (json-str message)})
 
-(defn new-messages 
-  ([since] (reverse (take-while (fn [m] (> (m :timestamp) since)) @messages)))
-  ([] (reverse (take 25 @messages))))
-
-(def random (java.util.Random.))
-(def max-user-int 1000000)
 
-(defn make-random-nick []
-  (let [nick (str "user-" (.nextInt random  max-user-int))]
-    (if (contains? @users nick)
-      (make-random-nick)
-      nick)))
-
-(defn updates
-  ([] {"users" (sort (keys @users)) "messages" (new-messages)})
-  ([since] {"users" (sort (keys @users)) "messages" (new-messages since)}))
+;; Database
 
 (defn do-select [query]
   (with-connection db
     (with-query-results rs query
       (doall rs))))
 
-(defn fetch-messages [room_id]
-  (let [query (str "SELECT m.content, m.created_on, u.nick FROM messages m, users u "
-                   "WHERE room_id = ? AND m.user_id = u.user_id")
-        res (do-select [query room_id])]
-    (map (fn [r] (struct message-struct (r :nick) (r :content) (.getTime (r :created_on))))
-         res)))
+;; User authentication
 
 (defn fetch-nick [nick]
   (let [query "SELECT * FROM users WHERE nick = ?"]
@@ -86,8 +91,89 @@
 (defn authorize-nick-hash [nick hash]
   (let [db-user (fetch-nick nick)]
     (if (and db-user (= (db-user :hash) hash))
-      (db-user :user_id)
-      false)))
+      db-user false)))
+
+;; Message handling
+
+(defn process-message-for-json [d]
+  (assoc d :created_on (.getTime (d :created_on))))
+
+(defn process-message-for-output [d]
+  (let [avatar (d :avatar)]
+    {"nick" (encode-html-entities (d :nick))
+     "avatar" (if avatar (encode-html-entities avatar) nil)
+     "created_on" (.format formatter (d :created_on))
+     "content" (encode-html-entities (d :content))}))
+
+(defn new-messages 
+  ([since-ts]
+     (let [since-date (new Date (long since-ts))]
+       (reverse (take-while (fn [m] (.after (m :created_on) since-date)) @messages))))
+  ([] (reverse (take 25 @messages))))
+
+(defn updates
+  ([] {"users" (sort (keys @users)) 
+       "messages" (map process-message-for-json (new-messages))})
+  ([since] {"users" (sort (keys @users)) 
+            "messages" (map process-message-for-json (new-messages since))}))
+
+(defn fetch-messages-by-room [room-id]
+  (let [query (str "SELECT m.content, m.created_on, u.nick, u.avatar " 
+                   "FROM messages m, users u "
+                   "WHERE room_id = ? AND m.user_id = u.user_id "
+                   "ORDER BY created_on DESC "
+                   "LIMIT 20")]
+    (do-select [query room-id])))
+
+(defn fetch-messages-by-nick [nick]
+  (let [query (str "SELECT m.content, m.created_on, u.nick, u.avatar "
+                   "FROM messages m, users u "
+                   "WHERE m.user_id = u.user_id AND u.nick = ? "
+                   "ORDER BY created_on DESC "
+                   "LIMIT 20")]
+    (do-select [query nick])))
+
+;; Templates
+
+(defn set-user-attributes [st session]
+  (if (session :nick)
+    (.setAttribute st "user_nick" (session :nick))))
+
+(defn fetch-template [template-name session]
+  (let [st (.getInstanceOf template-group template-name)]
+    (and st
+     (do
+       (set-user-attributes st session)
+       st))))
+
+;; Landing
+
+(defn landing [session]
+  (let [nick (session :nick)]
+    (if nick
+      (redirect-to (str "/u/" nick))
+      (serve-file "static" "index.html"))))
+
+(defn login [session params]
+  (let [nick (params :nick)
+        hash (params :hash)
+        db-user (authorize-nick-hash nick hash)]
+    (if db-user
+      (dosync
+       (let [user-struct (struct user-struct (db-user :user_id) ; DB naming
+                                 nick (System/currentTimeMillis))]
+         (alter users assoc nick user-struct)
+         [(session-assoc :user-id (db-user :user_id) 
+                         :nick nick 
+                         :avatar (db-user :avatar))
+          (resp-success "OK")]))
+      (resp-error "BAD_LOGIN"))))
+
+(defn logout [session]
+  [(session-dissoc :nick :user-id)
+   (redirect-to "/")])
+
+;; Registration
 
 (defn register [session params]
   (let [nick (params :nick)
@@ -101,45 +187,80 @@
                        [nick hash email])
         (resp-success "OK")))))
 
-(defn init [session]
+;; Profile
+
+(defn non-empty-string? [s]
+  (and s (> (count s) 0)))
+
+(defn profile [session profile-nick]
+  (let [user-info (fetch-nick profile-nick)]
+    (if user-info
+      (let [nick (session :nick)
+            is-home (and nick (= nick profile-nick))  
+            has-avatar (non-empty-string? (user-info :avatar))            
+            dumps (fetch-messages-by-nick profile-nick)
+            st (fetch-template "profile" session)]
+        (do
+          (.setAttribute st "is_home" is-home)
+          (doseq [a [:nick :avatar :contact :bio]]
+            (.setAttribute st (name a) (encode-html-entities (or (user-info a) nil))))
+          (.setAttribute st "dumps"
+                         (to-array (map process-message-for-output dumps)))
+        (.toString st)))
+      (resp-error "NO_USER"))))
+
+(defn update-profile [session params]
+  (let [user-id (session :user-id)
+        attr (params :attr)
+        val (params :val)
+        attr-set #{"avatar" "contact" "bio"}]
+    (if (and user-id attr val 
+             (contains? attr-set attr))
+      (do
+        (with-connection db
+          (update-values "users" ["user_id = ?" user-id] {attr val}))
+        (if (= attr "avatar")
+          [(session-assoc :avatar val) "OK"]
+          "OK"))
+      (resp-error "BAD_REQUEST"))))
+
+;; Chat
+
+(defn chat [session]
   (let [now (System/currentTimeMillis)
+        nick (session :nick)
         user-id (session :user-id)
-        nick (session :nick)        
-        resp (updates)]
-    (dosync
-     (if (and user-id nick)
-       (let [user-struct (struct user-struct user-id nick now)]
-         (alter users assoc nick user-struct)
-         (resp-success (merge resp {"nick" nick})))
-       [(session-assoc :last-seen now)
-        (resp-success resp)]))))
-
-(defn login [session params]
-  (let [old-nick (session :nick)
-        nick (params :nick)
-        hash (params :hash)
-        user-id (authorize-nick-hash nick hash)]
-    (if user-id
+        st (fetch-template "chat" session)
+        message-list (to-array
+                      (map process-message-for-output
+                           (reverse (fetch-messages-by-room 1))))]
+    (if nick
       (dosync
-       (set-session {:user-id user-id :nick nick})
-       (let [user-struct (struct user-struct user-id nick (System/currentTimeMillis))]
-         (alter users dissoc old-nick)
-         (alter users assoc nick user-struct)
-         [(session-assoc :user-id user-id :nick nick)
-          (resp-success "OK")]))
-      (resp-error "BAD_LOGIN"))))
+       (let [user-struct (struct user-struct user-id nick now)]
+         (alter users assoc nick user-struct))))
+    (.setAttribute st "users" (map encode-html-entities 
+                                   (sort (keys @users))))
+    (.setAttribute st "messages" message-list)
+    (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))
+    (if nick
+      (.toString st)
+      [(session-assoc :last-seen now)
+       (.toString st)])))
 
 (defn refresh [session]
   (let [nick (session :nick)
         now (System/currentTimeMillis)]
-    (dosync
-     (if (contains? (ensure users) nick)
-       (let [last-seen (get-in @users [nick :last-seen])]
-         (alter users assoc-in [nick :last-seen] now)
-         (resp-success (updates last-seen)))
-       (let [last-seen (max (or (session :last-seen) 0) (- now (* 60 20)))]
-         [(session-assoc :last-seen now)
-          (updates last-seen)])))))
+    (if (or nick (session :last-seen))
+      (dosync
+       (if (contains? (ensure users) nick)
+         (let [last-seen (get-in @users [nick :last-seen])]
+           (alter users assoc-in [nick :last-seen] now)
+           (resp-success (updates last-seen)))
+         (let [last-seen (session :last-seen)]
+           [(session-assoc :last-seen now)
+            (updates last-seen)])))
+      ; TODO: session should store room-id of anon. users
+      (resp-error "NOT_IN_CHAT"))))
 
 (defn msg-transaction [nick msg]
   (dosync
@@ -157,8 +278,10 @@
 (defn msg [session params]
    (let [user-id (session :user-id)
          nick (session :nick)
+         avatar (session :avatar)
          content (params :content)
-         msg (struct message-struct nick content (System/currentTimeMillis))]
+         now (new Date)
+         msg (struct message-struct nick avatar content now)]
      (if (msg-transaction nick msg)
        (do
          (msg-db user-id 1 msg)
@@ -166,14 +289,17 @@
        (resp-error "MUST_LOGIN"))))
 
 (defroutes pichat
-  (GET "/" (serve-file "static" "index.html"))
+  (GET "/" (landing session))
   (GET "/static/*" (or (serve-file "static" (params :*))
                        :next))
   (GET "/favicon.ico" (serve-file "static" "favicon.ico"))
+  (GET "/u/:nick" (profile session (-> request :route-params :nick)))
+  (GET "/update-profile" (update-profile session params))
+  (GET "/login" (login session params))
+  (GET "/logout" (logout session))
   (GET "/register" (serve-file "static" "register.html"))
   (GET "/submit-registration" (register session params))
-  (GET "/login" (login session params))
-  (GET "/init" (init session))
+  (GET "/chat" (chat session))
   (GET "/refresh" (refresh session))
   (GET "/msg" (msg session params))
   (ANY "*" [404 "Page not found"]))
@@ -185,7 +311,7 @@
 
 ; Load messages from database
 (dosync
- (ref-set messages (fetch-messages 1)))
+ (ref-set messages (fetch-messages-by-room 1)))
 
 (run-server {:port 8080}
   "/*" (servlet pichat))