s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

Change email with user identifier/login

Browse Source
This commit is contained in:
Filip Gralinski 2019-11-25 22:38:59 +01:00
parent d4ba5df3e5
commit 9b75d75cbd
2 changed files with 31 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
Handler/AccountReset.hs
View File

@ -20,18 +20,18 @@ getCreateResetLinkR = do
postCreateResetLinkR :: Handler Html postCreateResetLinkR :: Handler Html
postCreateResetLinkR = do postCreateResetLinkR = do
((result, _), _) <- runFormPost createResetLinkForm ((result, _), _) <- runFormPost createResetLinkForm
let mEmail = case result of let mUserIdentifier = case result of
FormSuccess (email, _) -> Just email FormSuccess (userIdentifier, _) -> Just userIdentifier
_ -> Nothing _ -> Nothing
let mCourseId = case result of let mCourseId = case result of
FormSuccess (_, Just courseId) -> Just courseId FormSuccess (_, Just courseId) -> Just courseId
_ -> Nothing _ -> Nothing
doCreateResetLink mEmail mCourseId doCreateResetLink mUserIdentifier mCourseId
doCreateResetLink :: Maybe Text -> Maybe CourseId -> Handler Html doCreateResetLink :: Maybe Text -> Maybe CourseId -> Handler Html
doCreateResetLink (Just email) mCourseId = do doCreateResetLink (Just userIdentifier) mCourseId = do
mUserEnt <- runDB $ getBy $ UniqueUser email mUserEnt <- runDB $ getBy $ UniqueUser userIdentifier
userId <- createOrUse mUserEnt email userId <- createOrUse mUserEnt userIdentifier
addParticipant userId mCourseId addParticipant userId mCourseId
@ -45,28 +45,42 @@ doCreateResetLink (Just email) mCourseId = do
$(widgetFile "reset-link-created") $(widgetFile "reset-link-created")
doCreateResetLink Nothing _ = do doCreateResetLink Nothing _ = do
setMessage $ toHtml ("No e-mail given" :: Text) setMessage $ toHtml ("No user identifier given" :: Text)
getCreateResetLinkR getCreateResetLinkR
addParticipant userId Nothing = return () addParticipant :: (PersistStoreWrite (YesodPersistBackend site),
YesodPersist site,
BaseBackend (YesodPersistBackend site) ~ SqlBackend)
=> Key User -> Maybe (Key Course) -> HandlerFor site ()
addParticipant _ Nothing = return ()
addParticipant userId (Just courseId) = do addParticipant userId (Just courseId) = do
runDB $ insert $ Participant userId courseId _ <- runDB $ insert $ Participant userId courseId
return () return ()
createOrUse :: Maybe (Entity User) -> Text -> Handler UserId createOrUse :: Maybe (Entity User) -> Text -> Handler UserId
createOrUse (Just userEnt) _ = return $ entityKey userEnt createOrUse (Just userEnt) _ = return $ entityKey userEnt
createOrUse Nothing email = do createOrUse Nothing userIdentifier = do
setMessage $ toHtml ("Created new user " ++ email) setMessage $ toHtml ("Created new user " ++ userIdentifier)
triggerToken <- newToken triggerToken <- newToken
userId <- runDB $ insert $ User email Nothing Nothing False Nothing True Nothing Nothing Nothing (Just triggerToken) userId <- runDB $ insert $ User userIdentifier
Nothing
Nothing
False
Nothing
True
Nothing
Nothing
Nothing
(Just triggerToken)
return userId return userId
createResetLinkForm :: Form (Text, Maybe CourseId) createResetLinkForm :: Form (Text, Maybe CourseId)
createResetLinkForm = renderBootstrap3 BootstrapBasicForm $ (,) createResetLinkForm = renderBootstrap3 BootstrapBasicForm $ (,)
<$> areq textField (bfs MsgEMail) Nothing <$> areq textField (bfs MsgUserIdentifier) Nothing
<*> coursesSelectFieldList <*> coursesSelectFieldList
coursesSelectFieldList :: (PersistQueryRead (YesodPersistBackend site), YesodPersist site, RenderMessage site FormMessage, RenderMessage site AppMessage, BaseBackend (YesodPersistBackend site) ~ SqlBackend) => AForm (HandlerFor site) (Maybe (Key Course))
coursesSelectFieldList = aopt (selectField courses) (bfs MsgCourseOptional) Nothing coursesSelectFieldList = aopt (selectField courses) (bfs MsgCourseOptional) Nothing
where where
courses = do courses = do
@ -120,7 +134,7 @@ doResetPassword' :: Bool -> Text -> Key User -> Text -> Handler Html
doResetPassword' True _ userId password = do doResetPassword' True _ userId password = do
updatePassword userId (Just password) updatePassword userId (Just password)
runDB $ update userId removeVerificationKeyStatement runDB $ update userId removeVerificationKeyStatement
setMessage $ toHtml ("Password set! Now, you can log in with your e-mail address." :: Text) setMessage $ toHtml ("Password set! Now, you can log in with your login." :: Text)
redirect HomeR redirect HomeR
doResetPassword' False key _ _ = do doResetPassword' False key _ _ = do
@ -143,5 +157,6 @@ changePasswordForm :: AccountStatus -> Form Text
changePasswordForm accountStatus = renderBootstrap3 BootstrapBasicForm changePasswordForm accountStatus = renderBootstrap3 BootstrapBasicForm
$ areq passwordConfirmField (bfs $ passwordFormHeader accountStatus) Nothing $ areq passwordConfirmField (bfs $ passwordFormHeader accountStatus) Nothing
passwordFormHeader :: AccountStatus -> AppMessage
passwordFormHeader NewlyCreated = MsgPasswordForNewAccount passwordFormHeader NewlyCreated = MsgPasswordForNewAccount
passwordFormHeader PasswordReset = MsgPassword passwordFormHeader PasswordReset = MsgPassword

1
messages/en.msg
View File

@ -87,3 +87,4 @@ ChallengeDeadlineDay: challenge deadline day
ChallengeDeadlineTime: challenge deadline time ChallengeDeadlineTime: challenge deadline time
ChallengeDeadlineTooltip: no submissions will be accepted after the deadline; this can be used for organizing competitions set in time ChallengeDeadlineTooltip: no submissions will be accepted after the deadline; this can be used for organizing competitions set in time
WritingPapers: writing papers with Gonito WritingPapers: writing papers with Gonito
UserIdentifier: user login/identifier