Safe Haskell | None |
---|---|
Language | Haskell98 |
This module contains all the central authentication functionality.
It exports a number of high-level functions to be used directly in your application handlers.
We also export a number of mid-level functions that should be helpful when you are integrating with another way of confirming the authentication of login requests.
- createUser :: Text -> ByteString -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- usernameExists :: Text -> Handler b (AuthManager b) Bool
- saveUser :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- destroyUser :: AuthUser -> Handler b (AuthManager b) ()
- loginByUsername :: Text -> Password -> Bool -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- loginByRememberToken :: Handler b (AuthManager b) (Either AuthFailure AuthUser)
- forceLogin :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
- logout :: Handler b (AuthManager b) ()
- currentUser :: Handler b (AuthManager b) (Maybe AuthUser)
- isLoggedIn :: Handler b (AuthManager b) Bool
- markAuthSuccess :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- markAuthFail :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- checkPasswordAndLogin :: AuthUser -> Password -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- data AuthManager b = IAuthBackend r => AuthManager {}
- class IAuthBackend r where
- data AuthSettings = AuthSettings {}
- defAuthSettings :: AuthSettings
- data AuthUser = AuthUser {
- userId :: Maybe UserId
- userLogin :: Text
- userEmail :: Maybe Text
- userPassword :: Maybe Password
- userActivatedAt :: Maybe UTCTime
- userSuspendedAt :: Maybe UTCTime
- userRememberToken :: Maybe Text
- userLoginCount :: Int
- userFailedLoginCount :: Int
- userLockedOutUntil :: Maybe UTCTime
- userCurrentLoginAt :: Maybe UTCTime
- userLastLoginAt :: Maybe UTCTime
- userCurrentLoginIp :: Maybe ByteString
- userLastLoginIp :: Maybe ByteString
- userCreatedAt :: Maybe UTCTime
- userUpdatedAt :: Maybe UTCTime
- userResetToken :: Maybe Text
- userResetRequestedAt :: Maybe UTCTime
- userRoles :: [Role]
- userMeta :: HashMap Text Value
- defAuthUser :: AuthUser
- newtype UserId = UserId {}
- data Password
- data AuthFailure
- data Role = Role ByteString
- authSettingsFromConfig :: Initializer b v AuthSettings
- withBackend :: (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a) -> Handler b (AuthManager v) a
- encryptPassword :: Password -> IO Password
- checkPassword :: Password -> Password -> Bool
- authenticatePassword :: AuthUser -> Password -> Maybe AuthFailure
- setPassword :: AuthUser -> ByteString -> IO AuthUser
- encrypt :: ByteString -> IO ByteString
- verify :: ByteString -> ByteString -> Bool
- registerUser :: ByteString -> ByteString -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
- loginUser :: ByteString -> ByteString -> Maybe ByteString -> (AuthFailure -> Handler b (AuthManager b) ()) -> Handler b (AuthManager b) () -> Handler b (AuthManager b) ()
- logoutUser :: Handler b (AuthManager b) () -> Handler b (AuthManager b) ()
- requireUser :: SnapletLens b (AuthManager b) -> Handler b v a -> Handler b v a -> Handler b v a
- setPasswordResetToken :: Text -> Handler b (AuthManager b) (Maybe Text)
- clearPasswordResetToken :: Text -> Handler b (AuthManager b) Bool
- addAuthSplices :: HasHeist b => Snaplet (Heist b) -> SnapletLens b (AuthManager b) -> Initializer b v ()
- compiledAuthSplices :: SnapletLens b (AuthManager b) -> Splices (SnapletCSplice b)
- userCSplices :: Monad m => Splices (RuntimeSplice m AuthUser -> Splice m)
- userISplices :: Monad m => AuthUser -> Splices (Splice m)
- ifLoggedIn :: SnapletLens b (AuthManager b) -> SnapletISplice b
- ifLoggedOut :: SnapletLens b (AuthManager b) -> SnapletISplice b
- loggedInUser :: SnapletLens b (AuthManager b) -> SnapletISplice b
Higher Level Handler Functions
:: Text | Username |
-> ByteString | Password |
-> Handler b (AuthManager b) (Either AuthFailure AuthUser) |
Create a new user from just a username and password
:: Text | The username to be checked |
-> Handler b (AuthManager b) Bool |
Check whether a user with the given username exists.
saveUser :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser) Source #
Create or update a given user
destroyUser :: AuthUser -> Handler b (AuthManager b) () Source #
Destroy the given user
:: Text | Username/login for user |
-> Password | Should be ClearText |
-> Bool | Set remember token? |
-> Handler b (AuthManager b) (Either AuthFailure AuthUser) |
Lookup a user by her username, check given password and perform login
loginByRememberToken :: Handler b (AuthManager b) (Either AuthFailure AuthUser) Source #
Remember user from the remember token if possible and perform login
:: AuthUser | An existing user, somehow looked up from db |
-> Handler b (AuthManager b) (Either AuthFailure ()) |
Login and persist the given AuthUser
in the active session
Meant to be used if you have other means of being sure that the person is who she says she is.
logout :: Handler b (AuthManager b) () Source #
Logout the active user
currentUser :: Handler b (AuthManager b) (Maybe AuthUser) Source #
Return the current user; trying to remember from cookie if possible.
isLoggedIn :: Handler b (AuthManager b) Bool Source #
Convenience wrapper around rememberUser
that returns a bool result
Lower Level Functions
markAuthSuccess :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser) Source #
Mutate an AuthUser
, marking successful authentication
This will save the user to the backend.
markAuthFail :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser) Source #
Mutate an AuthUser
, marking failed authentication
This will save the user to the backend.
checkPasswordAndLogin Source #
:: AuthUser | An existing user, somehow looked up from db |
-> Password | A ClearText password |
-> Handler b (AuthManager b) (Either AuthFailure AuthUser) |
Authenticate and log the user into the current session if successful.
This is a mid-level function exposed to allow roll-your-own ways of looking up a user from the database.
This function will:
- Check the password
- Login the user into the current session
- Mark success/failure of the authentication trial on the user record
Types
data AuthManager b Source #
Abstract data type holding all necessary information for auth operation
IAuthBackend r => AuthManager | |
|
class IAuthBackend r where Source #
All storage backends need to implement this typeclass
save :: r -> AuthUser -> IO (Either AuthFailure AuthUser) Source #
Create or update the given AuthUser
record. A userId
of Nothing
indicates that a new user should be created, otherwise the user
information for that userId should be updated.
lookupByUserId :: r -> UserId -> IO (Maybe AuthUser) Source #
lookupByLogin :: r -> Text -> IO (Maybe AuthUser) Source #
lookupByEmail :: r -> Text -> IO (Maybe AuthUser) Source #
lookupByRememberToken :: r -> Text -> IO (Maybe AuthUser) Source #
data AuthSettings Source #
Authentication settings defined at initialization time
AuthSettings | |
|
defAuthSettings :: AuthSettings Source #
Default settings for Auth.
asMinPasswdLen = 8 asRememberCookieName = "_remember" asRememberPeriod = Just (2*7*24*60*60) = 2 weeks asLockout = Nothing asSiteKey = "site_key.txt"
Type representing the concept of a User in your application.
defAuthUser :: AuthUser Source #
Default AuthUser that has all empty values.
Internal representation of a User
. By convention, we demand that the
application is able to directly fetch a User
using this identifier.
Think of this type as a secure, authenticated user. You should normally never see this type unless a user has been authenticated.
Password is clear when supplied by the user and encrypted later when returned from the db.
data AuthFailure Source #
Authentication failures indicate what went wrong during authentication. They may provide useful information to the developer, although it is generally not advisable to show the user the exact details about why login failed.
AuthError String | |
BackendError | |
DuplicateLogin | |
EncryptedPassword | |
IncorrectPassword | |
LockedOut UTCTime | Locked out until given time |
PasswordMissing | |
UsernameMissing | |
UserNotFound |
This will be replaced by a role-based permission system.
Other Utilities
authSettingsFromConfig :: Initializer b v AuthSettings Source #
Function to get auth settings from a config file. This function can be used by the authors of auth snaplet backends in the initializer to let the user configure the auth snaplet from a config file. All options are optional and default to what's in defAuthSettings if not supplied. Here's what the default options would look like in the config file:
minPasswordLen = 8 rememberCookie = "_remember" rememberPeriod = 1209600 # 2 weeks lockout = [5, 86400] # 5 attempts locks you out for 86400 seconds siteKey = "site_key.txt"
:: (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a) | The function to run with the handler. |
-> Handler b (AuthManager v) a |
Run a function on the backend, and return the result.
This uses an existential type so that the backend type doesn't
escape
AuthManager. The reason that the type is Handler b
(AuthManager v) a and not a is because anything that uses the
backend will return an IO something, which you can liftIO, or a
Handler b (AuthManager v) a if it uses other handler things.
:: AuthUser | Looked up from the back-end |
-> Password | Check against this password |
-> Maybe AuthFailure |
Check password for a given user.
Returns Nothing if check is successful and an IncorrectPassword error otherwise
setPassword :: AuthUser -> ByteString -> IO AuthUser Source #
Set a new password for the given user. Given password should be
clear-text; it will be encrypted into a Encrypted
.
encrypt :: ByteString -> IO ByteString Source #
The underlying encryption function, in case you need it for external processing.
:: ByteString | Cleartext |
-> ByteString | Encrypted reference |
-> Bool |
The underlying verify function, in case you need it for external processing.
Handlers
:: ByteString | Login field |
-> ByteString | Password field |
-> Handler b (AuthManager b) (Either AuthFailure AuthUser) |
Register a new user by specifying login and password Param
fields
:: ByteString | Username field |
-> ByteString | Password field |
-> Maybe ByteString | Remember field; Nothing if you want no remember function. |
-> (AuthFailure -> Handler b (AuthManager b) ()) | Upon failure |
-> Handler b (AuthManager b) () | Upon success |
-> Handler b (AuthManager b) () |
A MonadSnap
handler that processes a login form.
The request paremeters are passed to performLogin
To make your users stay logged in for longer than the session replay prevention timeout, you must pass a field name as the third parameter and that field must be set to a value of "1" by the submitting form. This lets you use a user selectable check box. Or if you want user remembering always turned on, you can use a hidden form field.
:: Handler b (AuthManager b) () | What to do after logging out |
-> Handler b (AuthManager b) () |
Simple handler to log the user out. Deletes user from session.
:: SnapletLens b (AuthManager b) | Lens reference to an AuthManager |
-> Handler b v a | Do this if no authenticated user is present. |
-> Handler b v a | Do this if an authenticated user is present. |
-> Handler b v a |
Require that an authenticated AuthUser
is present in the current
session.
This function has no DB cost - only checks to see if a user_id is present in the current session.
setPasswordResetToken :: Text -> Handler b (AuthManager b) (Maybe Text) Source #
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.
clearPasswordResetToken :: Text -> Handler b (AuthManager b) Bool Source #
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.
Splice helpers
:: HasHeist b | |
=> Snaplet (Heist b) | |
-> SnapletLens b (AuthManager b) | A lens reference to |
-> Initializer b v () |
Add all standard auth splices to a Heist-enabled application.
This adds the following splices: <ifLoggedIn> <ifLoggedOut> <loggedInUser>
compiledAuthSplices :: SnapletLens b (AuthManager b) -> Splices (SnapletCSplice b) Source #
List containing compiled splices for ifLoggedIn, ifLoggedOut, and loggedInUser.
userCSplices :: Monad m => Splices (RuntimeSplice m AuthUser -> Splice m) Source #
Compiled splices for AuthUser.
userISplices :: Monad m => AuthUser -> Splices (Splice m) Source #
Function to generate interpreted splices from an AuthUser.
ifLoggedIn :: SnapletLens b (AuthManager b) -> SnapletISplice b Source #
A splice that can be used to check for existence of a user. If a user is present, this will run the contents of the node.
<ifLoggedIn> Show this when there is a logged in user </ifLoggedIn>
ifLoggedOut :: SnapletLens b (AuthManager b) -> SnapletISplice b Source #
A splice that can be used to check for absence of a user. If a user is not present, this will run the contents of the node.
<ifLoggedOut> Show this when there is a logged in user </ifLoggedOut>
loggedInUser :: SnapletLens b (AuthManager b) -> SnapletISplice b Source #
A splice that will simply print the current user's login, if there is one.