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.
|
-- Who can access which pages.
|
||||||
isAuthorized r w = case (r, w) of
|
isAuthorized r w = case (r, w) of
|
||||||
|
(AuthR a , True)
|
||||||
|
| a == resendVerifyR -> personFromResendForm
|
||||||
|
(AuthR (PluginR "account" ["verify", u, _]), False) -> personUnver u
|
||||||
|
|
||||||
(GroupsR , True) -> personAny
|
(GroupsR , True) -> personAny
|
||||||
(GroupNewR , _ ) -> personAny
|
(GroupNewR , _ ) -> personAny
|
||||||
(GroupMembersR grp , True) -> groupAdmin grp
|
(GroupMembersR grp , True) -> groupAdmin grp
|
||||||
|
@ -225,6 +229,14 @@ instance Yesod App where
|
||||||
Nothing -> return AuthenticationRequired
|
Nothing -> return AuthenticationRequired
|
||||||
Just p -> f p
|
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 :: Handler AuthResult
|
||||||
personAny = personAnd $ \ _p -> return Authorized
|
personAny = personAnd $ \ _p -> return Authorized
|
||||||
|
|
||||||
|
@ -236,6 +248,40 @@ instance Yesod App where
|
||||||
then Authorized
|
then Authorized
|
||||||
else Unauthorized "No access to this operation"
|
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 :: (GroupRole -> Bool) -> ShrIdent -> Handler AuthResult
|
||||||
groupRole role grp = personAnd $ \ (Entity pid _p) -> runDB $ do
|
groupRole role grp = personAnd $ \ (Entity pid _p) -> runDB $ do
|
||||||
Entity sid _s <- getBy404 $ UniqueSharer grp
|
Entity sid _s <- getBy404 $ UniqueSharer grp
|
||||||
|
|
Loading…
Reference in a new issue