module Lucienne.Model.User ( User, newUser, name, mayAddUsers, changePassword , userByNameQuery, userByNameAndPasswordQuery) where import qualified Data.ByteString.Lazy.Char8 as BS import Data.Digest.Pure.SHA (showDigest,sha1) import Data.Bson (Document,(=:),at) import qualified Data.CompactString.UTF8 as CS import Lucienne.DatabaseAble (DatabaseAble(..)) data User = User { name :: String , password :: String , mayAddUsers :: Bool } deriving (Show) newUser :: String -> String -> Bool -> User newUser name password mayAddUsers = User name (hashPassword password) mayAddUsers hashPassword :: String -> String hashPassword = showDigest . sha1 . BS.pack changePassword :: User -> String -> User changePassword user newPassword = user { password = hashPassword newPassword } instance DatabaseAble User where toDocument user = [ "_id" =: CS.pack (name user) , "password" =: CS.pack (password user) , "mayAddUsers" =: mayAddUsers user ] fromDocument document = let name = CS.unpack $ "_id" `at` document password = CS.unpack $ "password" `at` document mayAddUsers = "mayAddUsers" `at` document in User name password mayAddUsers userByNameQuery :: String -> Document userByNameQuery name = [ "_id" =: CS.pack name ] userByNameAndPasswordQuery :: String -> String -> Document userByNameAndPasswordQuery name password = [ "_id" =: CS.pack name , "password" =: CS.pack (hashPassword password) ]