module Web.Users.Types where
import Control.Applicative
import Data.Aeson
import Data.Int
import Data.Time.Clock
import Data.Typeable
import Web.PathPieces
import qualified Data.Text as T
data CreateUserError
= UsernameOrEmailAlreadyTaken
| InvalidPassword
deriving (Show, Eq)
data UpdateUserError
= UsernameOrEmailAlreadyExists
| UserDoesntExit
deriving (Show, Eq)
data TokenError
= TokenInvalid
deriving (Show, Eq)
class (Show (UserId b), Eq (UserId b), ToJSON (UserId b), FromJSON (UserId b), Typeable (UserId b), PathPiece (UserId b)) => UserStorageBackend b where
type UserId b :: *
initUserBackend :: b -> IO ()
destroyUserBackend :: b -> IO ()
housekeepBackend :: b -> IO ()
getUserById :: (FromJSON a, ToJSON a) => b -> UserId b -> IO (Maybe (User a))
listUsers :: (FromJSON a, ToJSON a) => b -> Maybe (Int64, Int64) -> IO [(UserId b, User a)]
countUsers :: b -> IO Int64
createUser :: (FromJSON a, ToJSON a) => b -> User a -> IO (Either CreateUserError (UserId b))
updateUser :: (FromJSON a, ToJSON a) => b -> UserId b -> (User a -> User a) -> IO (Either UpdateUserError ())
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 ()
deleteUser :: b -> UserId b -> IO ()
authUser :: b -> T.Text -> T.Text -> NominalDiffTime -> IO (Maybe SessionId)
verifySession :: b -> SessionId -> NominalDiffTime -> IO (Maybe (UserId b))
destroySession :: b -> SessionId -> IO ()
requestPasswordReset :: b -> UserId b -> NominalDiffTime -> IO PasswordResetToken
verifyPasswordResetToken :: (FromJSON a, ToJSON a) => b -> PasswordResetToken -> IO (Maybe (User a))
applyNewPassword :: b -> PasswordResetToken -> T.Text -> IO (Either TokenError ())
requestActivationToken :: b -> UserId b -> NominalDiffTime -> IO ActivationToken
activateUser :: b -> ActivationToken -> IO (Either TokenError ())
newtype PasswordResetToken
= PasswordResetToken { unPasswordResetToken :: T.Text }
deriving (Show, Eq, ToJSON, FromJSON, Typeable, PathPiece)
newtype ActivationToken
= ActivationToken { unActivationToken :: T.Text }
deriving (Show, Eq, ToJSON, FromJSON, Typeable, PathPiece)
newtype SessionId
= SessionId { unSessionId :: T.Text }
deriving (Show, Eq, ToJSON, FromJSON, Typeable, PathPiece)
data Password
= PasswordPlain !T.Text
| PasswordHash !T.Text
| PasswordHidden
deriving (Show, Eq, Typeable)
data User a
= 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) =
object
[ "name" .= name
, "email" .= email
, "active" .= active
, "more" .= more
]
instance FromJSON a => FromJSON (User a) where
parseJSON =
withObject "User" $ \obj ->
User <$> obj .: "name"
<*> obj .: "email"
<*> (parsePassword <$> (obj .:? "password"))
<*> obj .: "active"
<*> obj .: "more"
where
parsePassword maybePass =
case maybePass of
Nothing -> PasswordHidden
Just pwd -> PasswordPlain pwd