fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Prevent user from locking themselves out (authpreds)

Browse Source
This commit is contained in:
Gregor Kleen 2018-12-06 18:55:06 +01:00
parent aea7837c49
commit 3541c1dc40
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Home.hs
View File

@ -283,8 +283,12 @@ getAuthPredsR, postAuthPredsR :: Handler Html
getAuthPredsR = postAuthPredsR getAuthPredsR = postAuthPredsR
postAuthPredsR = do postAuthPredsR = do
(AuthTagActive authTagCurrentActive) <- fromMaybe def <$> lookupSessionJson SessionActiveAuthTags (AuthTagActive authTagCurrentActive) <- fromMaybe def <$> lookupSessionJson SessionActiveAuthTags
let taForm authTag = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag) let
blacklist = Set.fromList [ AuthFree, AuthDevelopment, AuthDeprecated ]
taForm authTag
| authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag)
| otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag)
((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard
$ AuthTagActive $ AuthTagActive