Commit initial vip-only direct messaging

8 files changed, 217 insertions, 87 deletions

diff --git a/src/config.clj b/src/config.clj
index 5253379..c4e2fe3 100644
--- a/src/config.clj
+++ b/src/config.clj
@@ -31,4 +31,5 @@
 (def *dumps-per-page* 20)
 (def *vip-dumps-per-page* 200)
 (def message-count-limit 200)
-(def num-hall-dumps 50)
\ No newline at end of file
+(def num-hall-dumps 50)
+(def max-content-size 2468)
\ No newline at end of file
diff --git a/src/datalayer.clj b/src/datalayer.clj
index 139274b..28ef3bf 100644
--- a/src/datalayer.clj
+++ b/src/datalayer.clj
@@ -1,8 +1,13 @@
 (ns datalayer
   (:require redis
             tags)
-  (:use config
+  (:use clojure.contrib.sql
+        clojure.contrib.json.write
+        clojure.contrib.json.read
+        config
         jedis
+        message
+        user
         utils))
 
 
@@ -74,8 +79,6 @@ WHERE  u.nick = ANY(?)"
                AND m.message_id = ?"]
     (first (do-select [query (maybe-parse-int m-id -1)]))))
 
-
-
 ;;;; Popular Posts
 
 (def popular-dumps-qry "
@@ -145,3 +148,64 @@ order by count desc limit ? offset ?")
                    (redis/zrevrange "hall" 0 (dec num-hall-dumps))))]
     (if-not (empty? ids)
       (tags/fetch-dumps-by-ids ids viewer-nick))))
+
+;;;; Message insertion
+
+(def msg-insert-query
+  "INSERT INTO messages (user_id, room_id, content, is_image, is_text)
+   VALUES (?, ?, ?, ?, ?) RETURNING message_id, created_on")
+
+(defn insert-message-into-postgres! [author-id room-id content is-image is-text recips]
+  (with-connection *db*
+    (transaction
+     (let [{msg-id :message_id ts :created_on}
+           (first
+            (do-select [msg-insert-query
+                        author-id room-id content is-image is-text]))]
+       (doseq [r recips]
+         (insert-values
+          :direct_messages
+          [:message_id :author_id :recip_id]
+          [msg-id author-id (:user_id r)]))
+       [msg-id ts]))))
+
+(defn insert-recips-into-redis! [recips author-id ts content]
+  (let [dm-json (json-str {"author_id" author-id
+                           "recips" (map :nick recips)
+                           "content" content})]
+    (redis/with-server redis-server
+      (redis/atomically
+       (doseq [r recips]
+         (redis/zadd (str "directmessage:" (:user_id r))
+                     (.getTime ts)
+                     dm-json))))))
+
+(defn insert-message! [author-id author-nick room-id content]
+  (let [msg-type    (classify-msg content)
+        is-image    (boolean (#{:image :mixed} msg-type))
+        is-text     (boolean (#{:mixed :text} msg-type))
+        recips      (get-recips content)
+        [msg-id ts] (insert-message-into-postgres! author-id
+                                                   room-id
+                                                   content
+                                                   is-image
+                                                   is-text
+                                                   recips)]
+    (if-not (empty? recips)
+      (insert-recips-into-redis! recips author-id ts content))
+    {:author  author-nick
+     :msg-id  msg-id
+     :room    room-id
+     :db-ts   ts
+     :content content
+     :recips  (map (comp lower-case :nick) recips)}))
+
+(defn fetch-private-messages [user-id]
+  (for [dm (redis/with-server redis-server
+             (redis/zrevrange (str "directmessage:" user-id) 0 40))]
+    (let [dm    (read-json dm)
+          info  (fetch-user-id (get dm "author_id"))]
+      {"nick"    (:nick info)
+       "content" (get dm "content")
+       "recips"  (get dm "recips")
+       "avatar" (:avatar info)})))
diff --git a/src/feed.clj b/src/feed.clj
index c8454d0..898f085 100755
--- a/src/feed.clj
+++ b/src/feed.clj
@@ -16,6 +16,8 @@
         scheduled-agent
         utils))
 
+;; DEPRECATED
+
 (def *feeds-path* "docs/feeds.csv")
 
 (defn queue-image! [room-key img]
diff --git a/src/message.clj b/src/message.clj
new file mode 100644
index 0000000..a8e0e9b
--- /dev/null
+++ b/src/message.clj
@@ -0,0 +1,39 @@
+(ns message
+  (:use user))
+
+;; Message parsing
+
+;; http://snippets.dzone.com/posts/show/6995
+(def url-regex #"(?i)^((http\:\/\/|https\:\/\/|ftp\:\/\/)|(www\.))+(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?$")
+(def pic-regex #"(?i)\.(jpg|jpeg|png|gif|bmp|svg)(\?|&|$)")
+
+(defn is-image? [word]
+  (and (re-find url-regex word)
+       (re-find pic-regex word)))
+
+(defn take-images [content]
+  (filter is-image? (.split content " ")))
+
+(defn classify-msg [msg]
+  (let [words (.split msg " ")
+        imgs  (map is-image? words)]
+    (cond (every? boolean imgs) :image
+          (some boolean imgs)   :mixed
+          :else                 :text)))
+
+(def recip-regex #"(?:^|\s)@\w+")
+
+(defn get-recips [content]
+  (filter
+   boolean
+   (for [at-nick (re-seq recip-regex content)]
+     (fetch-nick (.substring (.trim at-nick) 1)))))
+
+(defn get-recips-from-msgs [msgs]
+  (let [recips (set (apply concat
+                           (for [m msgs]
+                             (re-seq recip-regex (:content m)))))]
+    (filter
+     boolean
+     (for [r recips]
+       (fetch-nick (.substring (.trim r) 1))))))
diff --git a/src/rooms.clj b/src/rooms.clj
index 574532a..3367ea9 100644
--- a/src/rooms.clj
+++ b/src/rooms.clj
@@ -6,7 +6,7 @@
         utils
         user))
 
-(defstruct message-struct :nick :content :created_on :msg_id)
+(defstruct message-struct :nick :content :created_on :msg_id :recips)
 
 (def *run-flusher* true)
 (def *flusher-sleep* (seconds 4))
@@ -99,19 +99,12 @@
 ; Note: To ensure that the msg's timestamp is consistent
 ;       with other msg creations, build-msg must be used
 ;       within a dosync.
-(defn build-msg [nick content msg-id]
-  (struct message-struct nick content (new Date) msg-id))
+(defn build-msg [nick content msg-id recips]
+  (struct message-struct nick content (new Date) msg-id recips))
 
 (defn add-message [msg room]
   (insert-and-truncate! (room :messages) msg message-count-limit))
 
-(defn insert-message-into-db! [user-id room-id content is-image]
-  (:message_id
-   (first
-    (do-select ["INSERT INTO messages (user_id, room_id, content, is_image)
-                 VALUES (?, ?, ?, ?) RETURNING message_id"
-                user-id room-id content is-image]))))
-
 (defn create-and-add-room! [key]
   (do-select ["INSERT INTO rooms (key, name, description)
                VALUES (?, ?, ?) RETURNING room_id"
diff --git a/src/site.clj b/src/site.clj
index cf6ae14..7db43e7 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -21,10 +21,10 @@
         datalayer
         email
         fame
+        message
         utils
         cookie-login
         session-sweeper
-        feed
         rooms
         tags
         scheduled-agent
@@ -119,14 +119,13 @@
 
 ;;  User-id/nick cache
 ;;  I keep needing to grab user-id from a nick so I thought I'd cache them
-;;  @timb: I just duplicated this in the user-info map :(
-;;         we should reconcile our user caches
-(def user-id-cache (ref {}))
+;;  sostler todo: will replace this w/ user/user-id-cache soon
+(def *user-id-cache* (ref {}))
 (def *user-id-cache-size* 500)
 
 (defn user-id-from-nick [nick]
   (let [nick (lower-case nick)
-        found (@user-id-cache nick)]
+        found (@*user-id-cache* nick)]
     (if found
       found
       (let [query (str "SELECT user_id FROM users WHERE lower(nick) = ?")
@@ -135,8 +134,8 @@
           nil
           (let [found (res :user_id)]
             (dosync
-              (if (> (count @user-id-cache) *user-id-cache-size*) (ref-set user-id-cache {}))
-                (alter user-id-cache assoc nick found))
+              (if (> (count @*user-id-cache*) *user-id-cache-size*) (ref-set *user-id-cache* {}))
+                (alter *user-id-cache* assoc nick found))
             found))))))
 
 ;; Login code
@@ -384,7 +383,7 @@ ORDER BY cnt DESC
      (if-let [user-info (fetch-nick profile-nick)]
        (let [st            (fetch-template template session)
              profile-nick  (:nick user-info) ; Update to get right casing
-             nick          (session :nick)
+             nick          (:nick session)
              logger        (make-time-logger)
              is-home       (and nick (= nick profile-nick))
              score         (if use-redis-favscore
@@ -394,6 +393,10 @@ ORDER BY cnt DESC
                                    :user-tag-id (:user_id session)
 				   :nick profile-nick
 				   :limit 10)
+             dms           (if-vip
+                            (fetch-private-messages (:user_id user-info)))
+             recips        (if dms
+                             (set (concat (map #(get % "recips") dms))))
              imgs          (pull-random-dump-images dumps 5)]
          (do
            (.setAttribute st "is_home" is-home)
@@ -403,6 +406,9 @@ ORDER BY cnt DESC
 			      (if (non-empty-string? v) (escape-html v)))))
 	   (.setAttribute st "score" (comma-format score))
 	   (.setAttribute st "score_ent" (score-to-entity score))
+           (when-not (empty? dms)
+             (.setAttribute st "dms" dms)
+             (.setAttribute st "recips" (json-str (map lower-case recips))))
            (if (not (empty? imgs))
 	     (.setAttribute st "imgs" imgs))
 	   (.setAttribute st "debug_log_items" (logger))
@@ -411,7 +417,8 @@ ORDER BY cnt DESC
 
 (defn update-user-db [user-id attr val]
   (with-connection *db*
-    (update-values "users" ["user_id = ?" user-id] {attr val})))
+    (update-values "users" ["user_id = ?" user-id] {attr val}))
+  (update-cache! user-id attr val))
 
 (defn update-avatar [session url] 
   (update-user-db (session :user_id) "avatar" url)
@@ -614,6 +621,7 @@ ORDER BY cnt DESC
                                                       :user-tag-id (:user_id session)
                                                       :hide-vip false
                                                       :limit (:history_size room)))
+          recips           (map :nick (get-recips-from-msgs raw-msgs))
 	  message-list     (to-array (map process-message-for-output raw-msgs))]
       (if nick
 	(dosync
@@ -621,6 +629,7 @@ ORDER BY cnt DESC
       (doto st
 	(.setAttribute "users" (prepare-user-list room true))
 	(.setAttribute "messages" message-list)
+        (.setAttribute "recips" (json-str (map lower-case recips)))
 	(.setAttribute "roomkey" (room :key))
 	(.setAttribute "isadminroom" (room :admin_only))
 	(.setAttribute "json_room_key" (json-str (room :key)))
@@ -670,34 +679,29 @@ ORDER BY cnt DESC
           (str "<unsafe>" content "</unsafe>"))
       (str content)))
 
-(defn msg-db [user-id room-id content]
-  (let [msg-type (classify-msg content)
-        is-image (boolean (#{:image :mixed} msg-type))
-        is-text  (boolean (#{:mixed :text} msg-type))
-	qry      (str "INSERT INTO messages (user_id, room_id, content, is_image, is_text) "
-		      "VALUES (?, ?, ?, ?, ?) RETURNING message_id")]
-    (with-connection *db*
-      ((first (do-select [qry user-id room-id content is-image is-text]))
-       :message_id))))
-
 (defn msg [session params]
-   (let [user-id      (session :user_id)
-         mute         (get (poll *active-mutes*) user-id)
-         nick         (session :nick)
-         room-key     (params :room)
-         room         (lookup-room room-key)
-         content      (.trim (params :content))]
-     (cond (not room) (resp-error "BAD_ROOM")
-           (not nick) (resp-error "NOT_LOGGED_IN")
-           mute       (resp-error (format-mute mute))
+   (let [user-id                 (session :user_id)
+         mute                    (get (poll *active-mutes*) user-id)
+         nick                    (session :nick)
+         room-key                (params :room)
+         room                    (lookup-room room-key)
+         content                 (.trim (params :content))
+         content-too-long?       (> (count content)
+                                    max-content-size)]
+     (cond (not room)          (resp-error "BAD_ROOM")
+           (not nick)          (resp-error "NOT_LOGGED_IN")
+           content-too-long?   (resp-error "TOO_LONG")
+           mute                (resp-error (format-mute mute))
            :else
-	   (let [content  (validated-content content session)
-	         msg-id   (msg-db user-id (room :room_id) content)]
+	   (let [content    (validated-content content session)
+	         msg-info   (insert-message! user-id nick (:room_id room) content)
+                 msg-id     (:msg-id msg-info)]
 	     (dosync
               (if (not (contains? (ensure (room :users)) nick))
                 (login-user (user-struct-from-session session) room))
-              (add-message (build-msg nick content msg-id) room))
-	     (resp-success msg-id)))))
+              (add-message (build-msg nick content msg-id (:recips msg-info)) room))
+             (resp-success {:msgid msg-id
+                            :recips (:recips msg-info)})))))
 
 
 (defn validated-msg [session params request]
@@ -737,7 +741,8 @@ ORDER BY cnt DESC
         dump-offset (* offset *dumps-per-page*)
         image-only  (and (not (room :admin_only))
                          (not= (params :show) "all"))
-        raw-dumps   (logger tags/fetch-dumps-by-room :room-id (room :room_id)
+        raw-dumps   (logger tags/fetch-dumps-by-room
+                            :room-id (room :room_id)
                             :image-only image-only
                             :amount (+ 1 *dumps-per-page*)
                             :offset dump-offset)
@@ -1113,21 +1118,20 @@ ORDER BY cnt DESC
 ; errors.
 ; The upload code doesn't use jQuery.ajax, and doesn't JSON-eval
 ; responses. Therefore, return strings should not be JSON-encoded.
-
 (defn do-upload [session image room]
   (if-let [err (validate-upload-file (image :tempfile) room)]
     (resp-error err)
-    (let [filename (format-filename (:filename image) (session :nick))
-          date (today)
-          dest (open-file [*image-directory* date] filename)
-          url (image-url-from-file "images" date dest)
-          msg-id (msg-db (session :user_id) (room :room_id) url)
-          msg (struct message-struct (session :nick) url (new Date) msg-id)]
-      (do 
-        (dosync
-         (add-message msg room))
-        (copy (:tempfile image) dest)
-        [200 "OK"]))))
+    (let [filename   (format-filename (:filename image) (session :nick))
+          date       (today)
+          dest       (open-file [*image-directory* date] filename)
+          url        (image-url-from-file "images" date dest)
+          msg-info   (insert-message! (:user_id session) (:nick session)
+                                      (:room_id room) url)]
+      (copy (:tempfile image) dest)
+      (dosync
+       (let [msg (build-msg (:nick session) url (:msg-id msg-info) (:recips msg-info))]
+         (add-message msg room)))
+      [200 "OK"])))
 
 (defn upload [session params request]
   (let [room-key   (params :room)
diff --git a/src/user.clj b/src/user.clj
index 1d59944..7641bd8 100644
--- a/src/user.clj
+++ b/src/user.clj
@@ -16,12 +16,62 @@
    (> (count n) 16) "NICK_TOO_LONG"
    (not (re-matches *nick-regex* n)) "NICK_INVALID_CHARS"))
 
+;;; User info cache
+
+(def user-cache-size 500)
+(def user-nick-cache (ref {}))
+(def user-id-cache (ref {}))
+
+(defn update-cache! [uid attr val]
+  (dosync
+   (if-let [info (get @user-id-cache uid)]
+     (let [nick  (lower-case (:nick info))
+           new-info (assoc info attr val)]
+       (alter user-id-cache assoc uid new-info)
+       (alter user-nick-cache assoc nick new-info)))))
+     
+
 (defn fetch-nick [nick]
-  (let [q1 "SELECT * FROM users WHERE nick = ? LIMIT 1"
-        ; ORDER BY ensures consistent retrieval of ambiguious names
-        q2 "SELECT * FROM users WHERE lower(nick) = ? ORDER BY nick LIMIT 1"]
-    (or (first-or-nil (do-select [q1 nick]))
-        (first-or-nil (do-select [q2 (lower-case nick)])))))
+  (let [lcnick (lower-case nick)]
+    (if (contains? user-nick-cache lcnick)
+      (get user-nick-cache lcnick)
+      (let [info  (first
+                    (do-select ["SELECT * FROM users WHERE lower(nick) = ? LIMIT 1"
+                                lcnick]))
+          user-id (:user_id info)]
+        (dosync
+         (alter user-nick-cache assoc lcnick info)
+         (if (and info user-id)
+           (alter user-id-cache assoc user-id info)))
+        info))))
+
+(defn fetch-nicks [nicks]
+  (let [lcnicks       (map lower-case nicks)
+        cache         @user-nick-cache
+        to-fetch      (filter #(not (contains? cache %)) lcnicks)
+        fetched-info  (do-select ["SELECT * FROM users WHERE lower(nick) = ANY(?)"
+                                  (sql-array "text" to-fetch)])
+        info-map      (zipmap (map (comp lower-case :nick) fetched-info)
+                              fetched-info)]
+    (doseq [nick to-fetch]
+      (let [info (get info-map nick)]
+        (dosync
+         (alter user-nick-cache assoc nick info)
+         (if info
+           (alter user-id-cache assoc (:user_id info) info)))))
+    (filter
+     boolean
+     (for [nick lcnicks]
+       (get @user-nick-cache nick)))))
+
+(defn fetch-user-id [uid]
+  (if (contains? @user-id-cache uid)
+    (get @user-id-cache uid)
+    (if-let [info (first
+                   (do-select ["SELECT * FROM users WHERE user_id = ? LIMIT 1" uid]))]
+      (dosync
+       (alter user-nick-cache assoc (lower-case (:nick info)) info)
+       (alter user-id-cache assoc uid info)))))
 
 (defn authorize-nick-hash [nick hash]
   (let [db-user (fetch-nick nick)]
diff --git a/src/utils.clj b/src/utils.clj
index 84454cd..8aaffba 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -36,26 +36,6 @@
                            (.setMaxConnections 10))}))
 
 
-;; Message parsing
-
-;; http://snippets.dzone.com/posts/show/6995
-(def url-regex #"(?i)^((http\:\/\/|https\:\/\/|ftp\:\/\/)|(www\.))+(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?$")
-(def pic-regex #"(?i)\.(jpg|jpeg|png|gif|bmp|svg)(\?|&|$)")
-
-(defn is-image? [word]
-  (and (re-find url-regex word)
-       (re-find pic-regex word)))
-
-(defn take-images [content]
-  (filter is-image? (.split content " ")))
-
-(defn classify-msg [msg]
-  (let [words (.split msg " ")
-        imgs  (map is-image? words)]
-    (cond (every? boolean imgs) :image
-          (some boolean imgs)   :mixed
-          :else                 :text)))
-
 ;; Misc
 
 (defn except! [& more]
@@ -415,9 +395,6 @@
 (defn serve-template [template session]
   (.toString (fetch-template template session)))
 
-(defn first-or-nil [l]
-  (if (empty? l) nil (first l)))
-
 ;; VIP
 
 (defn is-vip? [session]