{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, GADTs, GeneralizedNewtypeDeriving, RankNTypes #-}
{-# OPTIONS_HADDOCK prune #-}
module Authorisation (migrateData, User(..), UserId, mkUser, userList) where
import qualified Yesod as Y
import qualified Yesod.Auth.Account as YAA
import qualified Data.ByteString as DB
import qualified Data.Text as DT (Text, empty)
import Database.Persist (selectList, (==.))
import qualified Control.Monad.Trans.Reader (ReaderT)
import Database.Persist.Types (entityKey)
Y.share [Y.mkPersist Y.sqlSettings, Y.mkMigrate "migrateData"] [Y.persistUpperCase|
User
username DT.Text NOT NULL
password DB.ByteString
emailAddress DT.Text
verified Bool
verifyKey DT.Text
resetPasswordKey DT.Text
UniqueUsername username
Member
child UserId NOT NULL
parent UserId NOT NULL
Primary child parent
|]
mkUser :: DT.Text -> Y.Unique User
mkUser = UniqueUsername
userList :: forall (m :: * -> *). Y.MonadIO m => Control.Monad.Trans.Reader.ReaderT (Y.PersistEntityBackend User) m [UserId]
userList = map entityKey `fmap` selectList [ UserVerified ==. True ] []
instance YAA.PersistUserCredentials User where
userUsernameF = UserUsername
userPasswordHashF = UserPassword
userEmailF = UserEmailAddress
userEmailVerifiedF = UserVerified
userEmailVerifyKeyF = UserVerifyKey
userResetPwdKeyF = UserResetPasswordKey
uniqueUsername = UniqueUsername
userCreate name email key pwd = User name pwd email False key DT.empty