Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added password reset functionality to the auth snaplet

  • Loading branch information...
commit 2536305df78fc074b24080e8e71264fbb8012c1a 1 parent d0c158a
@mightybyte mightybyte authored
View
2  src/Snap/Snaplet/Auth.hs
@@ -60,6 +60,8 @@ module Snap.Snaplet.Auth
, loginUser
, logoutUser
, requireUser
+ , setPasswordResetToken
+ , clearPasswordResetToken
-- * Splice helpers
, addAuthSplices
View
42 src/Snap/Snaplet/Auth/Handlers.hs
@@ -496,3 +496,45 @@ withBackend ::
withBackend f = join $ do
(AuthManager backend_ _ _ _ _ _ _ _ _) <- get
return $ f backend_
+
+
+------------------------------------------------------------------------------
+-- | This function generates a random password reset token and stores it in
+-- the database for the user. Call this function when a user forgets their
+-- password. Then use the token to autogenerate a link that the user can
+-- visit to reset their password. This function also sets a timestamp so the
+-- reset token can be expired.
+setPasswordResetToken :: Text -> Handler b (AuthManager b) Bool
+setPasswordResetToken login = do
+ token <- liftIO . randomToken 40 =<< gets randomNumberGenerator
+ now <- liftIO getCurrentTime
+ modPasswordResetToken login (Just $ decodeUtf8 token) (Just now)
+
+
+------------------------------------------------------------------------------
+-- | Clears a user's password reset token. Call this when the user
+-- successfully changes their password to ensure that the password reset link
+-- cannot be used again.
+clearPasswordResetToken :: Text -> Handler b (AuthManager b) Bool
+clearPasswordResetToken login = modPasswordResetToken login Nothing Nothing
+
+
+------------------------------------------------------------------------------
+-- | Helper function used for setting and clearing the password reset token
+-- and associated timestamp.
+modPasswordResetToken :: Text
+ -> Maybe Text
+ -> Maybe UTCTime
+ -> Handler v (AuthManager v) Bool
+modPasswordResetToken login token timestamp = do
+ res <- runMaybeT $ do
+ u <- MaybeT $ withBackend $ \b -> liftIO $ lookupByLogin b login
+ lift $ saveUser $ u
+ { userResetToken = token
+ , userResetRequestedAt = timestamp
+ }
+ return ()
+ return $ maybe False (\_ -> True) res
+
+
+
View
17 src/Snap/Snaplet/Auth/Types.hs
@@ -9,6 +9,7 @@ module Snap.Snaplet.Auth.Types where
import Control.Applicative
import Control.Arrow
import Control.Monad.Trans
+import Control.Monad.Trans.Maybe
import Crypto.PasswordStore
import Data.Aeson
import Data.ByteString (ByteString)
@@ -20,6 +21,7 @@ import Data.Time
import Data.Text (Text)
import Data.Typeable
import Snap.Snaplet
+import Snap.Snaplet.Session.Common
------------------------------------------------------------------------------
@@ -120,6 +122,10 @@ data Role = Role ByteString
data AuthUser = AuthUser
{ userId :: Maybe UserId
, userLogin :: Text
+
+ -- We have to have an email field for password reset functionality, but we
+ -- don't want to force users to log in with their email address.
+ , userEmail :: Maybe Text
, userPassword :: Maybe Password
, userActivatedAt :: Maybe UTCTime
, userSuspendedAt :: Maybe UTCTime
@@ -133,6 +139,8 @@ data AuthUser = AuthUser
, userLastLoginIp :: Maybe ByteString
, userCreatedAt :: Maybe UTCTime
, userUpdatedAt :: Maybe UTCTime
+ , userResetToken :: Maybe Text
+ , userResetRequestedAt :: Maybe UTCTime
, userRoles :: [Role]
, userMeta :: HashMap Text Value
}
@@ -145,6 +153,7 @@ defAuthUser :: AuthUser
defAuthUser = AuthUser
{ userId = Nothing
, userLogin = ""
+ , userEmail = Nothing
@nurpax
nurpax added a note

I suppose this breaks schema compatibility with snap-0.9? (For snaplet-sqlite-simple and others that persist AuthUsers)

If so, perhaps I need to add some kind of a snap_auth_version table for doing migrates from previous versions of snap_auth_user table.

@mightybyte Owner

Well, in this case you could just check the existence of the fields. All the new ones are Maybes, so you can just default them to Nothing.

@nurpax
nurpax added a note

Hmm. SQLite is surprisingly cumbersome at migrations. :( It doesn't support ALTERs that add a column after another, SQLite can only add columns in the last position. E.g., I can't alter the existing table to add the 'email' column after 'login' to keep the old query code working with all these positional arguments. Since the fields in AuthUser are kept alphabetically sorted, adding new fields in new snap_auth_user schema versions means more work in snaplet-sqlite-simple as mirroring AuthUser field order in snap_auth_user table becomes uglier.

@mightybyte Owner

Ugh, yeah. Migrations can definitely be a pain. The main rule of thumb I know is to not make any code dependent on the ordering of columns in the sql schema. Other than that I don't have good answers. But your database columns shouldn't have to have the same ordering as the Haskell data structure.

@nurpax
nurpax added a note

Yep, it wasn't too bad after all. I have a few users at work for a webapp I wrote using snap + snaplet-sqlite-simple, so I wanted to get the auth migration done to make upgrading easier. Here's what I did: nurpax/snaplet-sqlite-simple@0a67355

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
, userPassword = Nothing
, userActivatedAt = Nothing
, userSuspendedAt = Nothing
@@ -158,6 +167,8 @@ defAuthUser = AuthUser
, userLastLoginIp = Nothing
, userCreatedAt = Nothing
, userUpdatedAt = Nothing
+ , userResetToken = Nothing
+ , userResetRequestedAt = Nothing
, userRoles = []
, userMeta = HM.empty
}
@@ -249,6 +260,7 @@ instance ToJSON AuthUser where
toJSON u = object
[ "uid" .= userId u
, "login" .= userLogin u
+ , "email" .= userEmail u
, "pw" .= userPassword u
, "activated_at" .= userActivatedAt u
, "suspended_at" .= userSuspendedAt u
@@ -262,6 +274,8 @@ instance ToJSON AuthUser where
, "last_ip" .= userLastLoginIp u
, "created_at" .= userCreatedAt u
, "updated_at" .= userUpdatedAt u
+ , "reset_token" .= userResetToken u
+ , "reset_requested_at" .= userResetRequestedAt u
, "roles" .= userRoles u
, "meta" .= userMeta u
]
@@ -272,6 +286,7 @@ instance FromJSON AuthUser where
parseJSON (Object v) = AuthUser
<$> v .: "uid"
<*> v .: "login"
+ <*> v .: "email"
<*> v .: "pw"
<*> v .: "activated_at"
<*> v .: "suspended_at"
@@ -285,6 +300,8 @@ instance FromJSON AuthUser where
<*> v .: "last_ip"
<*> v .: "created_at"
<*> v .: "updated_at"
+ <*> v .: "reset_token"
+ <*> v .: "reset_requested_at"
<*> v .:? "roles" .!= []
<*> v .: "meta"
parseJSON _ = error "Unexpected JSON input"
@nurpax

I suppose this breaks schema compatibility with snap-0.9? (For snaplet-sqlite-simple and others that persist AuthUsers)

If so, perhaps I need to add some kind of a snap_auth_version table for doing migrates from previous versions of snap_auth_user table.

@mightybyte

Well, in this case you could just check the existence of the fields. All the new ones are Maybes, so you can just default them to Nothing.

@nurpax

Hmm. SQLite is surprisingly cumbersome at migrations. :( It doesn't support ALTERs that add a column after another, SQLite can only add columns in the last position. E.g., I can't alter the existing table to add the 'email' column after 'login' to keep the old query code working with all these positional arguments. Since the fields in AuthUser are kept alphabetically sorted, adding new fields in new snap_auth_user schema versions means more work in snaplet-sqlite-simple as mirroring AuthUser field order in snap_auth_user table becomes uglier.

@mightybyte

Ugh, yeah. Migrations can definitely be a pain. The main rule of thumb I know is to not make any code dependent on the ordering of columns in the sql schema. Other than that I don't have good answers. But your database columns shouldn't have to have the same ordering as the Haskell data structure.

@nurpax

Yep, it wasn't too bad after all. I have a few users at work for a webapp I wrote using snap + snaplet-sqlite-simple, so I wanted to get the auth migration done to make upgrading easier. Here's what I did: nurpax/snaplet-sqlite-simple@0a67355

Please sign in to comment.
Something went wrong with that request. Please try again.