Permalink
Browse files

Allow people with current accounts to associate an OpenID

This is a rather large update that allows users with existing accounts
to associate an OpenID with their current account.  When a user logs
in, the :user returned by session/get-session is now a map, but this
is made backwards-compatible by most of the utility functions
accepting either a string or a map.
  • Loading branch information...
1 parent d993d36 commit c66fcb369992ed3214aae58c08f622740b3ff77b @chrismgray committed Dec 13, 2011
View
27 src/foreclojure/login.clj
@@ -5,14 +5,14 @@
[clj-openid.helpers :as helpers])
(:import [org.jasypt.util.password StrongPasswordEncryptor])
(:use [hiccup.form-helpers :only [form-to label text-field password-field check-box]]
- [foreclojure.utils :only [from-mongo flash-error flash-msg form-row assuming send-email login-url]]
+ [foreclojure.utils :only [from-mongo flash-error flash-msg form-row assuming send-email login-url get-user]]
[foreclojure.template :only [def-page content-page]]
[foreclojure.messages :only [err-msg]]
[compojure.core :only [defroutes GET POST]]
[useful.map :only [keyed]]
[clojail.core :only [thunk-timeout]]
[clojure.stacktrace :only [print-cause-trace]]
- [somnium.congomongo :only [update! fetch-one]]))
+ [somnium.congomongo :only [update! fetch-one destroy!]]))
(def password-reset-url "https://www.4clojure.com/settings")
@@ -58,10 +58,12 @@
{db-pwd :pwd} (from-mongo (fetch-one :users :where {:user user}))
location (session/session-get :login-to)]
(if (and db-pwd (.checkPassword (StrongPasswordEncryptor.) pwd db-pwd))
- (do (update! :users {:user user}
+ (let [{possible-openid :openid} (from-mongo (fetch-one :users :where {:user user} :only [:openid]))
+ merged-user {:user user :openid possible-openid}]
+ (update! :users {:user user}
{:$set {:last-login (java.util.Date.)}}
:upsert false) ; never create new users accidentally
- (session/session-put! :user user)
+ (session/session-put! :user merged-user)
(session/session-delete-key! :login-to)
(response/redirect (or location "/problems")))
(flash-error "/login" "Error logging in."))))
@@ -133,14 +135,21 @@
{:title "OpenID Failure"
:content (content-page {:main [:div [:p "The OpenID you provided could not be verified. Please go back and try again."]]})})
-(def-page openid-success [r]
+(defn openid-success [r]
(let [claimed-id (-> r :params :openid.claimed_id)
- user {:openid claimed-id}
+ user {:openid claimed-id}
+ session-user (session/session-get :user) ; non-nil if already logged in
+ session-user {:user (:user (get-user session-user))}
location (session/session-get :login-to)
- db-user (fetch-one :users :where {:user })]
- (update! :users {:user user}
+ merged-user (merge session-user user)]
+ (when (:user merged-user)
+ (update! :users {:user (:user merged-user)}
+ {:$set {:openid claimed-id}})
+ (destroy! :users {:user nil :openid claimed-id}))
+ (update! :users {:openid claimed-id}
{:$set {:last-login (java.util.Date.)}})
- (session/session-put! :user user)
+ (let [db-user (fetch-one :users :where {:openid claimed-id} :only [:user :openid])]
+ (session/session-put! :user db-user))
(session/session-delete-key! :login-to)
(response/redirect (or location "/problems"))))
View
6 src/foreclojure/problems.clj
@@ -5,7 +5,7 @@
[ring.util.response :as response]
[cheshire.core :as json])
(:import [org.apache.commons.mail EmailException])
- (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link flash-msg flash-error row-class approver? can-submit? send-email image-builder if-user with-user as-int maybe-update escape-html]]
+ (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link flash-msg flash-error row-class approver? can-submit? send-email image-builder if-user with-user as-int maybe-update escape-html user-attribute]]
[foreclojure.ring-utils :only [*url*]]
[foreclojure.template :only [def-page content-page]]
[foreclojure.social :only [tweet-link gist!]]
@@ -121,9 +121,7 @@
(maybe-update [old-score] dec)))))))))
(defn store-completed-state! [username problem-id code]
- (let [{user-id :_id} (fetch-one :users
- :where {:user username}
- :only [:_id])
+ (let [{user-id :_id} ((user-attribute :_id) username)
current-time (java.util.Date.)]
(when (not-any? #{problem-id} (get-solved username))
(update! :users {:_id user-id} {:$addToSet {:solved problem-id}
View
92 src/foreclojure/settings.clj
@@ -1,6 +1,7 @@
(ns foreclojure.settings
(:require [sandbar.stateful-session :as session]
- [ring.util.response :as response])
+ [ring.util.response :as response]
+ [foreclojure.login :as login])
(:import [org.jasypt.util.password StrongPasswordEncryptor])
(:use [hiccup.form-helpers :only [form-to label text-field password-field check-box]]
[foreclojure.utils :only [from-mongo flash-error flash-msg with-user form-row assuming send-email login-url plausible-email?]]
@@ -42,8 +43,14 @@
"Hide my solutions"]
[:br]))
+(defn assoc-openid-box [openid]
+ (list
+ [:p "Associate an OpenID with your account and you can log in with that in the future. Other settings will not change if this field is changed."]
+ (map form-row
+ [[text-field :openid "OpenID" openid]])))
+
(def-page settings-page []
- (with-user [{:keys [user email] :as user-obj}]
+ (with-user [{:keys [user email openid] :as user-obj}]
{:title "Account settings"
:content
(content-page
@@ -59,49 +66,56 @@
[:h3 "Hide My Solutions"]
[:div#settings-follow (hide-settings-box user-obj)]
[:hr]
+ [:h3 "Associate an OpenID with your account"]
+ [:div#assoc-openid (assoc-openid-box openid)]
+ [:hr]
[:h3 "Profile Image"]
[:div (gravatar-img {:email email :size 64})]
[:p "To change your profile image, visit <a href='http://gravatar.com' target='_blank'>Gravatar</a> and edit the image for '" email "'."]
[:div#button-div
[:button {:type "submit"} "Submit"]]))})}))
-(defn do-update-settings! [new-username old-pwd new-pwd repeat-pwd email disable-codebox hide-solutions]
- (with-user [{:keys [user pwd]}]
- (let [encryptor (StrongPasswordEncryptor.)
- new-pwd-hash (.encryptPassword encryptor new-pwd)
- new-lower-user (.toLowerCase new-username)]
- (assuming [(or (= new-lower-user user) (nil? (fetch-one :users :where {:user new-lower-user})))
- (err-msg "settings.user-exists"),
- (< 3 (.length new-lower-user) 14)
- (err-msg "settings.uname-size"),
- (= new-lower-user
- (first (re-seq #"[A-Za-z0-9_]+" new-lower-user)))
- (err-msg "settings.uname-alphanum")
- (or (empty? new-pwd) (< 6 (.length new-pwd)))
- (err-msg "settings.npwd-size"),
- (= new-pwd repeat-pwd)
- (err-msg "settings.npwd-match")
- (or (empty? new-pwd)
- (.checkPassword encryptor old-pwd pwd))
- (err-msg "settings.pwd-incorrect")
- (plausible-email? email)
- (err-msg "settings.email-invalid")
- (nil? (fetch-one :users :where {:email email :user {:$ne user}}))
- (err-msg "settings.email-exists")]
- (do
- (update! :users {:user user}
- {:$set {:pwd (if (seq new-pwd) new-pwd-hash pwd)
- :user new-lower-user
- :email email
- :disable-code-box (boolean disable-codebox)
- :hide-solutions (boolean hide-solutions)}}
- :upsert false)
- (session/session-put! :user new-lower-user)
- (flash-msg "/problems"
- (str "Account for " new-lower-user " updated successfully")))
- (flash-error "/settings" why)))))
+(defn do-update-settings! [new-username old-pwd new-pwd repeat-pwd email disable-codebox hide-solutions new-openid response-map]
+ (with-user [{:keys [user pwd openid]}]
+ (if (not= openid new-openid)
+ (do
+ (session/session-put! :login-to "/settings")
+ (login/do-openid-login (assoc-in response-map [:form-params "openid-url"] new-openid)))
+ (let [encryptor (StrongPasswordEncryptor.)
+ new-pwd-hash (.encryptPassword encryptor new-pwd)
+ new-lower-user (.toLowerCase new-username)]
+ (assuming [(or (= new-lower-user user) (nil? (fetch-one :users :where {:user new-lower-user})))
+ (err-msg "settings.user-exists"),
+ (< 3 (.length new-lower-user) 14)
+ (err-msg "settings.uname-size"),
+ (= new-lower-user
+ (first (re-seq #"[A-Za-z0-9_]+" new-lower-user)))
+ (err-msg "settings.uname-alphanum")
+ (or (empty? new-pwd) (< 6 (.length new-pwd)))
+ (err-msg "settings.npwd-size"),
+ (= new-pwd repeat-pwd)
+ (err-msg "settings.npwd-match")
+ (or (empty? new-pwd)
+ (.checkPassword encryptor old-pwd pwd))
+ (err-msg "settings.pwd-incorrect")
+ (plausible-email? email)
+ (err-msg "settings.email-invalid")
+ (nil? (fetch-one :users :where {:email email :user {:$ne user}}))
+ (err-msg "settings.email-exists")]
+ (do
+ (update! :users {:user user}
+ {:$set {:pwd (if (seq new-pwd) new-pwd-hash pwd)
+ :user new-lower-user
+ :email email
+ :disable-code-box (boolean disable-codebox)
+ :hide-solutions (boolean hide-solutions)}}
+ :upsert false)
+ (session/session-put! :user new-lower-user)
+ (flash-msg "/problems"
+ (str "Account for " new-lower-user " updated successfully")))
+ (flash-error "/settings" why))))))
(defroutes settings-routes
(GET "/settings" [] (settings-page))
- (POST "/settings" {{:strs [new-username old-pwd pwd repeat-pwd email disable-codebox hide-solutions]} :form-params}
- (do-update-settings! new-username old-pwd pwd repeat-pwd email disable-codebox hide-solutions)))
+ (POST "/settings" {{:strs [new-username old-pwd pwd repeat-pwd email disable-codebox hide-solutions openid]} :form-params :as r}
+ (do-update-settings! new-username old-pwd pwd repeat-pwd email disable-codebox hide-solutions openid r)))
View
3 src/foreclojure/template.clj
@@ -10,7 +10,8 @@
;; Global wrapping template
(defn html-doc [body]
(let [attrs (rendering-info (page-attributes body))
- user (session/session-get :user)]
+ user (session/session-get :user)
+ user (or (when (string? user) user) (:user user) (:openid user))]
(html
(doctype :html5)
[:html
View
6 src/foreclojure/users.clj
@@ -3,7 +3,7 @@
[clojure.string :as string]
[sandbar.stateful-session :as session]
[cheshire.core :as json])
- (:use [foreclojure.utils :only [from-mongo row-class rank-class get-user if-user with-user]]
+ (:use [foreclojure.utils :only [from-mongo row-class rank-class get-user if-user with-user user-attribute]]
[foreclojure.template :only [def-page content-page]]
[foreclojure.ring-utils :only [*http-scheme* universal-url]]
[foreclojure.config :only [config repo-url]]
@@ -21,9 +21,7 @@
(defn get-user-id [name]
(:_id
- (fetch-one :users
- :where {:user name}
- :only [:_id])))
+ ((user-attribute :_id) name)))
(defn get-users []
(from-mongo
View
31 src/foreclojure/utils.clj
@@ -123,8 +123,15 @@
data))
(defn get-user [username]
- (from-mongo
- (fetch-one :users :where {:user username})))
+ (cond
+ (string? username)
+ (from-mongo (fetch-one :users :where {:user username}))
+ (map? username)
+ (let [user (:user username)
+ openid (:openid username)]
+ (if user
+ (from-mongo (fetch-one :users :where {:user user}))
+ (from-mongo (fetch-one :users :where {:openid openid}))))))
(defmacro if-user
"Look for a user with the given username in the database, let-ing it
@@ -159,10 +166,22 @@
(defn user-attribute [attr]
(fn [username]
- (attr (from-mongo
- (fetch-one :users
- :where {:user username}
- :only [attr])))))
+ (cond
+ (string? username)
+ (attr (from-mongo
+ (fetch-one :users
+ :where {:user username}
+ :only [attr])))
+ (and (map? username) (:user username))
+ (attr (from-mongo
+ (fetch-one :users
+ :where {:user (:user username)}
+ :only [attr])))
+ (and (map? username) (:openid username))
+ (attr (from-mongo
+ (fetch-one :users
+ :where {:openid (:openid username)}
+ :only [attr]))))))
(def get-solved (comp set (user-attribute :solved)))
(def approver? (user-attribute :approver))

0 comments on commit c66fcb3

Please sign in to comment.