{-# LANGUAGE ExistentialQuantification #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE OverloadedStrings #-}moduleSnap.Snaplet.Auth.TypeswhereimportControl.Monad.CatchIOimportData.AesonimportData.ByteString(ByteString)importData.HashMap.Strict(HashMap)importqualifiedData.HashMap.StrictasHMimportData.Hashable(Hashable)importData.TimeimportData.TypeableimportData.Text(Text)importCrypto.PasswordStore-------------------------------------------------------------------------------- | Password is clear when supplied by the user and encrypted later when-- returned from the db.dataPassword=ClearTextByteString|EncryptedByteStringderiving(Read,Show,Ord,Eq)-------------------------------------------------------------------------------- Turn a 'ClearText' password into an 'Encrypted' password, ready to be-- stuffed into a database.encryptPassword::Password->IOPasswordencryptPasswordp@(Encrypted{})=returnpencryptPassword(ClearTextp)=dohashed<-makePasswordp12return$EncryptedhashedcheckPassword::Password->Password->BoolcheckPassword(ClearTextpw)(Encryptedpw')=verifyPasswordpwpw'checkPassword__=error"checkPassword failed. Make sure you pass ClearText passwords"-------------------------------------------------------------------------------- | 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.dataAuthFailure=UserNotFound|IncorrectPassword|PasswordMissing|LockedOutUTCTime-- ^ Locked out until given time|AuthErrorStringderiving(Read,Show,Ord,Eq,Typeable)instanceExceptionAuthFailure-------------------------------------------------------------------------------- | 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.newtypeUserId=UserId{unUid::Text}deriving(Read,Show,Ord,Eq,FromJSON,ToJSON,Hashable)-- | This will be replaced by a role-based permission system.dataRole=RoleByteStringderiving(Read,Show,Ord,Eq)-------------------------------------------------------------------------------- | Type representing the concept of a User in your application.dataAuthUser=AuthUser{userId::MaybeUserId,userLogin::Text,userPassword::MaybePassword,userActivatedAt::MaybeUTCTime,userSuspendedAt::MaybeUTCTime,userRememberToken::MaybeText,userLoginCount::Int,userFailedLoginCount::Int,userLockedOutUntil::MaybeUTCTime,userCurrentLoginAt::MaybeUTCTime,userLastLoginAt::MaybeUTCTime,userCurrentLoginIp::MaybeByteString,userLastLoginIp::MaybeByteString,userCreatedAt::MaybeUTCTime,userUpdatedAt::MaybeUTCTime,userRoles::[Role],userMeta::HashMapTextValue}deriving(Show,Eq)-------------------------------------------------------------------------------- | Default AuthUser that has all empty values.defAuthUser::AuthUserdefAuthUser=AuthUser{userId=Nothing,userLogin="",userPassword=Nothing,userActivatedAt=Nothing,userSuspendedAt=Nothing,userRememberToken=Nothing,userLoginCount=0,userFailedLoginCount=0,userLockedOutUntil=Nothing,userCurrentLoginAt=Nothing,userLastLoginAt=Nothing,userCurrentLoginIp=Nothing,userLastLoginIp=Nothing,userCreatedAt=Nothing,userUpdatedAt=Nothing,userRoles=[],userMeta=HM.empty}-------------------------------------------------------------------------------- | Set a new password for the given user. Given password should be-- clear-text; it will be encrypted into a 'Encrypted'.setPassword::AuthUser->ByteString->IOAuthUsersetPasswordaupass=dopw<-Encrypted`fmap`(makePasswordpass12)return$au{userPassword=Justpw}-------------------------------------------------------------------------------- | Authetication settings defined at initialization timedataAuthSettings=AuthSettings{asMinPasswdLen::Int-- ^ Currently not used/checked,asRememberCookieName::ByteString-- ^ Name of the desired remember cookie,asRememberPeriod::MaybeInt-- ^ How long to remember when the option is used in rest of the API.-- 'Nothing' means remember until end of session.,asLockout::Maybe(Int,NominalDiffTime)-- ^ Lockout strategy: ([MaxAttempts], [LockoutDuration]),asSiteKey::FilePath-- ^ Location of app's encryption key}-------------------------------------------------------------------------------- | Default settings for Auth.---- > asMinPasswdLen = 8-- > asRememberCookieName = "_remember"-- > asRememberPeriod = Just (2*7*24*60*60) = 2 weeks-- > asLockout = Nothing-- > asSiteKey = "site_key.txt"defAuthSettings::AuthSettingsdefAuthSettings=AuthSettings{asMinPasswdLen=8,asRememberCookieName="_remember",asRememberPeriod=Just(2*7*24*60*60),asLockout=Nothing,asSiteKey="site_key.txt"}dataBackendError=DuplicateLogin|BackendErrorStringderiving(Eq,Show,Read,Typeable)instanceExceptionBackendError