summaryrefslogtreecommitdiff
path: root/src/site.clj
blob: cce5da1220176d4c6407b79ee9760ffe5ae3d51e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
; site.clj

(ns pichat
  (:import java.lang.System)
  (:use compojure
        clojure.contrib.json.write))

(defstruct user-struct :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 30000)

(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 join-success [nick]
  (alter users assoc nick (struct user-struct nick (System/currentTimeMillis)))
  (let [users (sort (keys @users))
        messages (reverse (take 40 @messages))
        data {"users" users "messages" messages}]
    [(session-assoc :nick nick)
     (resp-success data)]))

(defn try-join [params]
  (let [nick (escape-html (params :nick))]
    (dosync
     (if (contains? @users nick)
       (resp-error "NICK_TAKEN")
       (join-success nick)))))

(defn new-messages [since]
  (reverse (take-while (fn [m] (> (m :timestamp) since)) @messages)))

(defn refresh [nick]
  (dosync
   (if (contains? @users nick)
     (let [last-seen (get-in @users [nick :last-seen])
           user-list (sort (keys @users))]
       (alter users assoc-in [nick :last-seen] (System/currentTimeMillis))
       (resp-success {"messages" (new-messages last-seen)
                      "users" user-list}))
     (resp-error "UNKNOWN_USER"))))

(defn msg [session params]
  (dosync
   (let [nick (session :nick)
         content (escape-html (params :content))
         msg (struct message-struct nick content (System/currentTimeMillis))]
     (if (contains? @users nick)
       (do (alter messages (swap cons) msg)
           (resp-success "OK"))
       (resp-error "UNKNOWN_USER")))))

(defroutes pichat
  (GET "/" (serve-file "static" "index.html"))
  (GET "/static/*" (or (serve-file "static" (params :*))
                       :next))
  (GET "/join" (try-join params))
  (GET "/refresh" (refresh (session :nick)))
  (GET "/msg" (msg session params))
  (ANY "*" [404 "Page not found"]))

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

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

(send-off flusher flush!)