diff options
| -rw-r--r-- | Foundation.hs | 12 | ||||
| -rw-r--r-- | Handler/User.hs | 21 | ||||
| -rw-r--r-- | sflctimekeeper.cabal | 1 | ||||
| -rw-r--r-- | templates/userpage.hamlet | 7 |
4 files changed, 29 insertions, 12 deletions
diff --git a/Foundation.hs b/Foundation.hs index 915230c..f76ec24 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -119,8 +119,8 @@ instance Yesod App where makeLogger = return . appLogger - isAuthorized (UserR u) True = isUser u - isAuthorized (UserR u) False = isUserOrAdmin u + isAuthorized (UserR u) True = isUserOrAssistant False u + isAuthorized (UserR u) False = isUserOrAssistant True u isAuthorized (CategoryR _) True = isAdmin isAuthorized (CategoryR _) False = return Authorized isAuthorized (EmploymentR e) True = isAdmin @@ -150,17 +150,17 @@ isAdmin = do Nothing -> AuthenticationRequired Just (Entity u v) -> if userIsAdmin v then Authorized else Unauthorized "You must be an admin" -isUserOrAssistant :: UserId -> Handler AuthResult -isUserOrAssistant t = do +isUserOrAssistant :: Bool -> UserId -> Handler AuthResult +isUserOrAssistant allowAdmin t = do ma <- maybeAuth case ma of Nothing -> return AuthenticationRequired - Just (Entity u _) -> case t == u of + Just (Entity u v) -> case t == u of True -> return Authorized False -> do mass <- runDB $ selectFirst [AssistantAssistant ==. u, AssistantAssisted ==. t] [] case mass of - Nothing -> return $ Unauthorized "That ain't your page." + Nothing -> return (if allowAdmin && userIsAdmin v then Authorized else Unauthorized "That ain't your page.") Just _ -> return Authorized -- How to run database actions. diff --git a/Handler/User.hs b/Handler/User.hs index 57886b6..8032da9 100644 --- a/Handler/User.hs +++ b/Handler/User.hs @@ -2,19 +2,26 @@ module Handler.User where import Import -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time.Clock (getCurrentTime, UTCTime, utctDay) import Yesod.Auth (maybeAuth) import Yesod.Form.Jquery (jqueryDayField, def) +import Control.Error.Util (hoistMaybe) +import Control.Monad (join) +import Control.Monad.Trans.Maybe (runMaybeT) getUserR :: UserId -> Handler Html getUserR cid = do user <- runDB $ get404 cid - ma <- maybeAuth + zzzma <- runMaybeT $ do + a <- hoistMaybe =<< lift maybeAuth + masst <- lift . runDB $ selectFirst [AssistantAssistant ==. entityKey a, AssistantAssisted ==. cid] [] + return (entityKey a, isJust masst) let username = userIdent user - let isThisUser = Just user == fmap entityVal ma + let isThisUser = Just cid == fmap fst zzzma + let isAssistant = Just True == fmap snd zzzma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages @@ -34,9 +41,13 @@ getUserR cid = do postUserR :: UserId -> Handler Html postUserR cid = do user <- runDB $ get404 cid - ma <- maybeAuth + zzzma <- runMaybeT $ do + a <- hoistMaybe =<< lift maybeAuth + masst <- lift . runDB $ selectFirst [AssistantAssistant ==. entityKey a, AssistantAssisted ==. cid] [] + return (entityKey a, isJust masst) let username = userIdent user - let isThisUser = Just user == fmap entityVal ma + let isThisUser = Just cid == fmap fst zzzma + let isAssistant = Just True == fmap snd zzzma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages diff --git a/sflctimekeeper.cabal b/sflctimekeeper.cabal index d5d78ac..6ea1be3 100644 --- a/sflctimekeeper.cabal +++ b/sflctimekeeper.cabal @@ -89,6 +89,7 @@ library , monad-logger >= 0.3 , fast-logger >= 0.3 , wai-logger >= 2.0 + , errors , base64-bytestring , case-insensitive , time diff --git a/templates/userpage.hamlet b/templates/userpage.hamlet index bacd299..8a9336a 100644 --- a/templates/userpage.hamlet +++ b/templates/userpage.hamlet @@ -15,8 +15,13 @@ $forall Entity _ emp <- employments $else , full-time +$if isAssistant + <p> + ASSISTANT +$else + -$if isThisUser +$if isThisUser || isAssistant <p> <form method=post action=@{UserR cid}#form enctype=#{formEnctype}> ^{formWidget} |