Permalink
Browse files

Add support for Snap.Auth remember me

  • Loading branch information...
1 parent 277ab64 commit 66f5deda6d42b3003367ea4753018eb05964f5f6 @ozataman committed Jan 10, 2011
Showing with 10 additions and 0 deletions.
  1. +10 −0 src/Snap/Extension/DB/MongoDB.hs
@@ -265,6 +265,7 @@ docToAuthUser v = do
, userSalt = Just salt
, userActivatedAt = DB.lookup "activated_at" v
, userSuspendedAt = DB.lookup "suspended_at" v
+ , userPersistenceToken = DB.lookup "persistence_token" v
, userCreatedAt = DB.lookup "created_at" v
, userUpdatedAt = DB.lookup "updated_at" v
, userCurrentLoginAt = DB.lookup "current_login_at" v
@@ -293,6 +294,7 @@ authUserToDoc usr = fields'
, Just $ ("salt" =: userSalt usr)
, Just $ ("activated_at" =: userActivatedAt usr)
, Just $ ("suspended_at" =: userSuspendedAt usr)
+ , Just $ ("persistence_token" =: userPersistenceToken usr)
, Just $ ("current_login_at" =: userCurrentLoginAt usr)
, Just $ ("last_login_at" =: userLastLoginAt usr)
, Just $ ("current_login_ip" =: userCurrentLoginIp usr)
@@ -312,6 +314,14 @@ instance (MonadAuth m, MonadMongoDB m) => MonadAuthUser m Document where
(,) <$> docToAuthUser d <*> r
+ getUserByRememberToken t = do
+ t' <- fmap u authUserTable
+ r <- withDB' $ findOne (select ["persistence_token" =: t] t')
+ return $ do
+ d <- r
+ (,) <$> docToAuthUser d <*> r
+
+
getUserExternal (EUId ps) = do
lookup_keys <- authAuthenticationKeys
t' <- fmap u authUserTable

0 comments on commit 66f5ded

Please sign in to comment.