add checkbox for anonimity

This commit is contained in:
Filip Gralinski 2017-03-18 14:51:09 +01:00
parent 63269ed852
commit 2661fda4f8
2 changed files with 13 additions and 8 deletions

View File

@ -17,24 +17,24 @@ getYourAccountR = do
user <- runDB $ get404 userId user <- runDB $ get404 userId
keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] [] keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] []
let key = publicKeyPubkey <$> entityVal <$> keyS let key = publicKeyPubkey <$> entityVal <$> keyS
(formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key) (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key (userIsAnonymous user))
defaultLayout $ do defaultLayout $ do
setTitle "Your account" setTitle "Your account"
$(widgetFile "your-account") $(widgetFile "your-account")
postYourAccountR :: Handler Html postYourAccountR :: Handler Html
postYourAccountR = do postYourAccountR = do
((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing) ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing False)
userId <- requireAuthId userId <- requireAuthId
user <- runDB $ get404 userId user <- runDB $ get404 userId
let accountData = case result of let accountData = case result of
FormSuccess res -> Just res FormSuccess res -> Just res
_ -> Nothing _ -> Nothing
case accountData of case accountData of
Just (name, localId, mPassword, sshPubKey, avatarFile) -> do Just (name, localId, mPassword, sshPubKey, avatarFile, anonimised) -> do
if checkPassword mPassword if checkPassword mPassword
then then
updateUserAccount userId name localId mPassword sshPubKey avatarFile updateUserAccount userId name localId mPassword sshPubKey avatarFile anonimised
else else
tooWeakPasswordMessage tooWeakPasswordMessage
Nothing -> do Nothing -> do
@ -48,13 +48,14 @@ checkPassword Nothing = True
checkPassword (Just "") = True checkPassword (Just "") = True
checkPassword (Just passwd) = isPasswordAcceptable passwd checkPassword (Just passwd) = isPasswordAcceptable passwd
yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe FileInfo) yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Bool -> Form (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe FileInfo, Bool)
yourAccountForm maybeName maybeLocalId maybeSshPubKey = renderBootstrap3 BootstrapBasicForm $ (,,,,) yourAccountForm maybeName maybeLocalId maybeSshPubKey anonimised = renderBootstrap3 BootstrapBasicForm $ (,,,,,)
<$> aopt textField (bfs MsgAccountName) (Just maybeName) <$> aopt textField (bfs MsgAccountName) (Just maybeName)
<*> aopt textField (bfs MsgId) (Just maybeLocalId) <*> aopt textField (bfs MsgId) (Just maybeLocalId)
<*> aopt passwordConfirmField (bfs MsgPassword) Nothing <*> aopt passwordConfirmField (bfs MsgPassword) Nothing
<*> aopt textField (bfs MsgSshPubKey) (Just maybeSshPubKey) <*> aopt textField (bfs MsgSshPubKey) (Just maybeSshPubKey)
<*> fileAFormOpt (bfs MsgAvatar) <*> fileAFormOpt (bfs MsgAvatar)
<*> areq checkBoxField (bfs MsgWantToBeAnonimised) (Just anonimised)
localIdRegexp :: Regex localIdRegexp :: Regex
localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String) localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String)
@ -70,11 +71,12 @@ isLocalIdAcceptable :: Text -> Bool
isLocalIdAcceptable localId = isLocalIdAcceptable localId =
match localIdRegexp (unpack localId) && not (localId `elem` unwantedLocalIds) match localIdRegexp (unpack localId) && not (localId `elem` unwantedLocalIds)
updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Handler () updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Bool -> Handler ()
updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAvatarFile = do updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAvatarFile anonimised = do
updateJustName userId name updateJustName userId name
updateAvatar userId maybeAvatarFile updateAvatar userId maybeAvatarFile
updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey
updateAnonimity userId anonimised
case maybePassword of case maybePassword of
Nothing -> return () Nothing -> return ()
Just "" -> return () Just "" -> return ()
@ -123,6 +125,8 @@ updateLocalIdAndPubKey _ Nothing Nothing = return ()
updateJustName :: Key User -> Maybe Text -> Handler () updateJustName :: Key User -> Maybe Text -> Handler ()
updateJustName userId name = runDB $ update userId [UserName =. name] updateJustName userId name = runDB $ update userId [UserName =. name]
updateAnonimity :: Key User -> Bool -> Handler ()
updateAnonimity userId anonimised = runDB $ update userId [UserIsAnonymous =. anonimised]
getAvatarR :: UserId -> Handler TypedContent getAvatarR :: UserId -> Handler TypedContent
getAvatarR userId = do getAvatarR userId = do

View File

@ -41,3 +41,4 @@ AchievementMaxWinners: maximum number of submitters
AchievementTags: tags required for an achievement AchievementTags: tags required for an achievement
Achievements: achievements Achievements: achievements
AchievementPoints: points AchievementPoints: points
WantToBeAnonimised: I want to stay anonymous for other user of Gonito.net