module Snap.Snaplet.Auth.Types where
import Control.Monad.CatchIO
import Data.Aeson
import Data.ByteString (ByteString)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Hashable (Hashable)
import Data.Time
import Data.Typeable
import Data.Text (Text)
import Crypto.PasswordStore
data Password = ClearText ByteString
| Encrypted ByteString
deriving (Read, Show, Ord, Eq)
encryptPassword :: Password -> IO Password
encryptPassword p@(Encrypted {}) = return p
encryptPassword (ClearText p) = do
hashed <- makePassword p 12
return $ Encrypted hashed
checkPassword :: Password -> Password -> Bool
checkPassword (ClearText pw) (Encrypted pw') = verifyPassword pw pw'
checkPassword _ _ =
error "checkPassword failed. Make sure you pass ClearText passwords"
data AuthFailure =
UserNotFound
| IncorrectPassword
| PasswordMissing
| LockedOut UTCTime
| AuthError String
deriving (Read, Show, Ord, Eq, Typeable)
instance Exception AuthFailure
newtype UserId = UserId { unUid :: Text }
deriving (Read,Show,Ord,Eq,FromJSON,ToJSON,Hashable)
data Role = Role ByteString
deriving (Read,Show,Ord,Eq)
data AuthUser = AuthUser
{ userId :: Maybe UserId
, userLogin :: 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
, userRoles :: [Role]
, userMeta :: HashMap Text Value
} deriving (Show,Eq)
defAuthUser :: AuthUser
defAuthUser = 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
}
setPassword :: AuthUser -> ByteString -> IO AuthUser
setPassword au pass = do
pw <- Encrypted `fmap` (makePassword pass 12)
return $ au { userPassword = Just pw }
data AuthSettings = AuthSettings {
asMinPasswdLen :: Int
, asRememberCookieName :: ByteString
, asRememberPeriod :: Maybe Int
, asLockout :: Maybe (Int, NominalDiffTime)
, asSiteKey :: FilePath
}
defAuthSettings :: AuthSettings
defAuthSettings = AuthSettings {
asMinPasswdLen = 8
, asRememberCookieName = "_remember"
, asRememberPeriod = Just (2*7*24*60*60)
, asLockout = Nothing
, asSiteKey = "site_key.txt"
}
data BackendError =
DuplicateLogin
| BackendError String
deriving (Eq,Show,Read,Typeable)
instance Exception BackendError