; site.clj

(ns pichat
  (:import java.lang.System
           clojure.lang.PersistentQueue
           org.apache.commons.codec.digest.DigestUtils
           javax.servlet.http.Cookie)
  (:use compojure
        clojure.contrib.json.write
        clojure.contrib.sql))

(let [db-host "localhost"
      db-port 5432
      db-name "dumpfm"]
  (def db {:classname "org.postgresql.Driver"
           :subprotocol "postgresql"
           :subname (str "//" db-host ":" db-port "/" db-name)
           :user "postgres"
           :password "root"}))

(defstruct user-struct :user-id :nick :last-seen)
(defstruct message-struct :nick :content :timestamp)

(def users (ref {}))
(def messages (ref []))

(def run-flusher true)
(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]
  (when run-flusher
    (send-off *agent* #'flush!))
  (dosync
   (let [now (System/currentTimeMillis)
         alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))]
     (ref-set users
              (into {} (filter alive? @users)))))
  (. Thread (sleep flusher-sleep-ms))
  x)

(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)}))

(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)))

(defn fetch-nick [nick]
  (let [query "SELECT * FROM users WHERE nick = ?"]
    (first (do-select [query nick]))))

(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)))

(defn register [session params]
  (let [nick (params :nick)
        email (params :email)
        hash (params :hash)]
    (if (fetch-nick nick)
      (resp-error "NICK_TAKEN")
      (with-connection db
        (insert-values :users 
                       [:nick :hash :email]
                       [nick hash email])
        (resp-success "OK")))))

(defn init [session]
  (prn session)
  (let [now (System/currentTimeMillis)
        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
      (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"))))

(defn refresh [session]
  (prn 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)])))))

(defn msg-transaction [nick msg]
  (dosync
   (if (contains? (ensure users) nick)
     (do (alter messages (swap cons) msg)
         true)
     false)))

(defn msg-db [user-id room-id msg]
  (with-connection db
    (insert-values :messages
                   [:user_id :room_id :content]
                   [user-id room-id (msg :content)])))

(defn msg [session params]
   (let [user-id (session :user-id)
         nick (session :nick)
         content (params :content)
         msg (struct message-struct nick content (System/currentTimeMillis))]
     (if (msg-transaction nick msg)
       (do
         (msg-db user-id 1 msg)
         (resp-success "OK"))
       (resp-error "MUST_LOGIN"))))

(defroutes pichat
  (GET "/" (serve-file "static" "index.html"))
  (GET "/static/*" (or (serve-file "static" (params :*))
                       :next))
  (GET "/favicon.ico" (serve-file "static" "favicon.ico"))
  (GET "/register" (serve-file "static" "register.html"))
  (GET "/submit-registration" (register session params))
  (GET "/login" (login session params))
  (GET "/init" (init session))
  (GET "/refresh" (refresh session))
  (GET "/msg" (msg session params))
  (ANY "*" [404 "Page not found"]))

(decorate pichat 
  (with-mimetypes)
  (with-session {:type :memory, :expires (* 60 60)}))


; Load messages from database
(dosync
 (ref-set messages (fetch-messages 1)))

(run-server {:port 8080}
  "/*" (servlet pichat))

(send-off flusher flush!)