summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Foundation.hs12
-rw-r--r--Handler/User.hs21
-rw-r--r--sflctimekeeper.cabal1
-rw-r--r--templates/userpage.hamlet7
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}