Resend POST and verify GET require unverified login
This commit is contained in:
parent
baeef7873e
commit
865d81c235
1 changed files with 46 additions and 0 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue