users 0.4.0.0 → 0.5.0.0
raw patch · 3 files changed
+51/−42 lines, 3 filesdep ~bcrypt
Dependency ranges changed: bcrypt
Files
- LICENSE +1/−1
- src/Web/Users/Types.hs +46/−38
- users.cabal +4/−3
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015 Alexander Thiemann+Copyright (c) 2015 - 2016 Alexander Thiemann Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
src/Web/Users/Types.hs view
@@ -3,17 +3,21 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} module Web.Users.Types ( -- * The core type class UserStorageBackend (..) -- * User representation , User(..), Password(..), makePassword, hidePassword , PasswordPlain(..), verifyPassword+ , UserField(..) -- * Token types , PasswordResetToken(..), ActivationToken(..), SessionId(..) -- * Error types , CreateUserError(..), UpdateUserError(..) , TokenError(..)+ -- * Helper typed+ , SortBy(..) ) where @@ -29,26 +33,18 @@ import qualified Data.Text.Encoding as T import qualified System.IO.Unsafe as U -{-# DEPRECATED UsernameOrEmailAlreadyTaken "Please use the more specific error constructors." #-}- -- | Errors that happen on storage level during user creation data CreateUserError- = UsernameOrEmailAlreadyTaken- | InvalidPassword+ = InvalidPassword | UsernameAlreadyTaken | EmailAlreadyTaken | UsernameAndEmailAlreadyTaken deriving (Show, Eq) -{-# DEPRECATED UsernameOrEmailAlreadyExists "Please use the more descriptive constructors instead." #-}-{-# DEPRECATED UserDoesntExit "Please use UserDoesntExist instead." #-}- -- | Errors that happen on storage level during user updating data UpdateUserError- = UsernameOrEmailAlreadyExists- | UsernameAlreadyExists+ = UsernameAlreadyExists | EmailAlreadyExists- | UserDoesntExit | UserDoesntExist deriving (Show, Eq) @@ -57,12 +53,28 @@ = TokenInvalid deriving (Show, Eq) +-- | Sorting direction+data SortBy t+ = SortAsc t+ | SortDesc t++-- | Backend constraints+type IsUserBackend b =+ ( Show (UserId b)+ , Eq (UserId b)+ , ToJSON (UserId b)+ , FromJSON (UserId b)+ , Typeable (UserId b)+ , PathPiece (UserId b)+ )+ -- | An abstract backend for managing users. A backend library should implement the interface and -- an end user should build applications on top of this interface.-class (Show (UserId b), Eq (UserId b), ToJSON (UserId b), FromJSON (UserId b), Typeable (UserId b), PathPiece (UserId b)) => UserStorageBackend b where+class IsUserBackend b => UserStorageBackend b where -- | The storage backends userid type UserId b :: *- -- | Initialise the backend. Call once on application launch to for example create missing database tables+ -- | Initialise the backend. Call once on application launch to for+ -- example create missing database tables initUserBackend :: b -> IO () -- | Destory the backend. WARNING: This is only for testing! It deletes all tables and data. destroyUserBackend :: b -> IO ()@@ -71,31 +83,21 @@ -- | Retrieve a user id from the database getUserIdByName :: b -> T.Text -> IO (Maybe (UserId b)) -- | Retrieve a user from the database- getUserById :: (FromJSON a, ToJSON a) => b -> UserId b -> IO (Maybe (User a))- -- | List all users (unlimited, or limited)- listUsers :: (FromJSON a, ToJSON a) => b -> Maybe (Int64, Int64) -> IO [(UserId b, User a)]+ getUserById :: b -> UserId b -> IO (Maybe User)+ -- | List all users unlimited, or limited, sorted by a 'UserField'+ listUsers :: b -> Maybe (Int64, Int64) -> SortBy UserField -> IO [(UserId b, User)] -- | Count all users countUsers :: b -> IO Int64 -- | Create a user- createUser :: (FromJSON a, ToJSON a) => b -> User a -> IO (Either CreateUserError (UserId b))+ createUser :: b -> User -> IO (Either CreateUserError (UserId b)) -- | Modify a user- updateUser :: (FromJSON a, ToJSON a) => b -> UserId b -> (User a -> User a) -> IO (Either UpdateUserError ())- -- | Modify details of a user- updateUserDetails :: (FromJSON a, ToJSON a) => b -> UserId b -> (a -> a) -> IO ()- updateUserDetails backend userId f =- do _ <-- updateUser backend userId $- \user ->- user- { u_more = f (u_more user)- }- return ()+ updateUser :: b -> UserId b -> (User -> User) -> IO (Either UpdateUserError ()) -- | Delete a user deleteUser :: b -> UserId b -> IO () -- | Authentificate a user using username/email and password. The 'NominalDiffTime' describes the session duration authUser :: b -> T.Text -> PasswordPlain -> NominalDiffTime -> IO (Maybe SessionId) -- | Authentificate a user and execute a single action.- withAuthUser :: FromJSON a => b -> T.Text -> (User a -> Bool) -> (UserId b -> IO r) -> IO (Maybe r)+ withAuthUser :: b -> T.Text -> (User -> Bool) -> (UserId b -> IO r) -> IO (Maybe r) -- | Verify a 'SessionId'. The session duration can be extended by 'NominalDiffTime' verifySession :: b -> SessionId -> NominalDiffTime -> IO (Maybe (UserId b)) -- | Force create a session for a user. This is useful for support/admin login.@@ -106,7 +108,7 @@ -- | Request a 'PasswordResetToken' for a given user, valid for 'NominalDiffTime' requestPasswordReset :: b -> UserId b -> NominalDiffTime -> IO PasswordResetToken -- | Check if a 'PasswordResetToken' is still valid and retrieve the owner of it- verifyPasswordResetToken :: (FromJSON a, ToJSON a) => b -> PasswordResetToken -> IO (Maybe (User a))+ verifyPasswordResetToken :: b -> PasswordResetToken -> IO (Maybe User) -- | Apply a new password to the owner of 'PasswordResetToken' iff the token is still valid applyNewPassword :: b -> PasswordResetToken -> Password -> IO (Either TokenError ()) -- | Request an 'ActivationToken' for a given user, valid for 'NominalDiffTime'@@ -166,37 +168,43 @@ deriving (Show, Eq, Typeable) -- | Strip the password from the user type.-hidePassword :: User a -> User a+hidePassword :: User -> User hidePassword user = user { u_password = PasswordHidden } --- | Core user datatype. Store custom information in the 'u_more' field-data User a+-- | Fields of user datatype+data UserField+ = UserFieldId+ | UserFieldName+ | UserFieldEmail+ | UserFieldPassword+ | UserFieldActive+ deriving (Show, Eq)++-- | Core user datatype+data User = User { u_name :: !T.Text , u_email :: !T.Text , u_password :: !Password , u_active :: !Bool- , u_more :: !a } deriving (Show, Eq, Typeable) -instance ToJSON a => ToJSON (User a) where- toJSON (User name email _ active more) =+instance ToJSON User where+ toJSON (User name email _ active) = object [ "name" .= name , "email" .= email , "active" .= active- , "more" .= more ] -instance FromJSON a => FromJSON (User a) where+instance FromJSON User where parseJSON = withObject "User" $ \obj -> User <$> obj .: "name" <*> obj .: "email" <*> (parsePassword <$> (obj .:? "password")) <*> obj .: "active"- <*> obj .: "more" where parsePassword maybePass = case maybePass of
users.cabal view
@@ -1,5 +1,5 @@ name: users-version: 0.4.0.0+version: 0.5.0.0 synopsis: A library simplifying user management for web applications description: Scrap the boilerplate for managing user accounts in web applications .@@ -18,6 +18,7 @@ Current Backends: . * <http://hackage.haskell.org/package/users-postgresql-simple PostgreSQL-Simple Backend>+ . * <http://hackage.haskell.org/package/users-persistent Persistent Backend> . homepage: https://github.com/agrafix/users@@ -26,7 +27,7 @@ license-file: LICENSE author: Alexander Thiemann <mail@athiemann.net> maintainer: Alexander Thiemann <mail@athiemann.net>-copyright: (c) 2015 Alexander Thiemann+copyright: (c) 2015 - 2016 Alexander Thiemann category: Web build-type: Simple cabal-version: >=1.10@@ -40,7 +41,7 @@ build-depends: aeson >=0.7, base >=4.6 && <5,- bcrypt >=0.0.6,+ bcrypt >=0.0.8, path-pieces >=0.1, text >=1.2, time >=1.4