Commit initial vip-only direct messaging

1 files changed, 49 insertions, 45 deletions

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)