diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 1e65b79..a3b1e3a 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -131,6 +131,10 @@ instance Yesod App where -- Who can access which pages. isAuthorized r w = case (r, w) of + (AuthR a , True) + | a == resendVerifyR -> personFromResendForm + (AuthR (PluginR "account" ["verify", u, _]), False) -> personUnver u + (GroupsR , True) -> personAny (GroupNewR , _ ) -> personAny (GroupMembersR grp , True) -> groupAdmin grp @@ -225,6 +229,14 @@ instance Yesod App where Nothing -> return AuthenticationRequired Just p -> f p + personUnverifiedAnd + :: (Entity Person -> Handler AuthResult) -> Handler AuthResult + personUnverifiedAnd f = do + mp <- maybeUnverifiedAuth + case mp of + Nothing -> return AuthenticationRequired + Just p -> f p + personAny :: Handler AuthResult personAny = personAnd $ \ _p -> return Authorized @@ -236,6 +248,40 @@ instance Yesod App where then Authorized else Unauthorized "No access to this operation" + personUnver :: Text -> Handler AuthResult + personUnver uname = personUnverifiedAnd $ \ p -> + if username p == uname + then return Authorized + else do + $logWarn $ T.concat + [ "User ", username p, " tried to verify user ", uname + ] + return $ Unauthorized "You can't verify other users" + + personFromResendForm :: Handler AuthResult + personFromResendForm = personUnverifiedAnd $ \ p -> do + ((result, _), _) <- + runFormPost $ renderDivs $ resendVerifyEmailForm "" + case result of + FormSuccess uname -> + if username p == uname + then return Authorized + else do + $logWarn $ T.concat + [ "User ", username p, " tried to POST to \ + \verification email resend for user ", uname + ] + return $ + Unauthorized + "You can't do that for other users" + _ -> do + $logWarn $ T.concat + [ "User ", username p, " tried to POST to \ + \verification email resend for invalid username" + ] + return $ + Unauthorized "Requesting resend for invalid username" + groupRole :: (GroupRole -> Bool) -> ShrIdent -> Handler AuthResult groupRole role grp = personAnd $ \ (Entity pid _p) -> runDB $ do Entity sid _s <- getBy404 $ UniqueSharer grp