diff options
| -rw-r--r-- | Foundation.hs | 13 | ||||
| -rw-r--r-- | config/models | 6 |
2 files changed, 17 insertions, 2 deletions
diff --git a/Foundation.hs b/Foundation.hs index 2d8f748..915230c 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -150,6 +150,19 @@ 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 + ma <- maybeAuth + case ma of + Nothing -> return AuthenticationRequired + Just (Entity u _) -> 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." + Just _ -> return Authorized + -- How to run database actions. instance YesodPersist App where type YesodPersistBackend App = SqlPersistT diff --git a/config/models b/config/models index 3240cfd..54723f0 100644 --- a/config/models +++ b/config/models @@ -21,5 +21,7 @@ TimeCategory disabled Bool UniqueTimeCategory name deriving Show Eq - - -- By default this file is used in Model.hs (which is imported by Foundation.hs) +Assistant + assistant UserId + assisted UserId + deriving Show Eq |