summaryrefslogtreecommitdiff
path: root/src/user.clj
blob: 7641bd8f46b4007040d072b1c2bbfce938a0995a (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
96
97
98
(ns user
  (:use compojure
        utils))

(defstruct user-struct :nick :user_id :avatar :last-seen)

(defn user-struct-from-session [session]
  (struct user-struct (session :nick) (session :user_id) (session :avatar)
          (System/currentTimeMillis)))

(def *nick-regex* #"^[A-Za-z0-9\-_âˆb˚†]*$")

(defn is-invalid-nick? [n]
  (cond
   (< (count n) 3) "NICK_TOO_SHORT"
   (> (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 [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)]
    (and db-user (= (db-user :hash) hash) db-user)))

(defn update-nick-hash [nick hash]
  (if (not (assert-update
            (do-update :users ["nick=?" nick]
                       {:hash hash})))
    ; TODO: logging
    (println (format "Error updating hash for %s" nick))))

(defn reset-token [nick hash ts]
  (sha1-hash nick hash ts))

(defn reset-link [nick token ts]
  (url-params "http://dump.fm/reset" {"nick"  nick
                                      "ts"    ts
                                      "token" token}))

(defn valid-reset-link? [nick token ts]
  (if-let [info (and nick (fetch-nick nick))]
    (and (= token (reset-token (info :nick) (info :hash) ts))
         (>= ts (ms-ago (days 2))))))