User.hs

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)
  ]