half-baked Personal Assistant feature

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}