diff --git a/Handler/AccountReset.hs b/Handler/AccountReset.hs index 2acd504..4c1d88b 100644 --- a/Handler/AccountReset.hs +++ b/Handler/AccountReset.hs @@ -21,15 +21,20 @@ postCreateResetLinkR :: Handler Html postCreateResetLinkR = do ((result, _), _) <- runFormPost createResetLinkForm let mEmail = case result of - FormSuccess email -> Just email + FormSuccess (email, _) -> Just email _ -> Nothing - doCreateResetLink mEmail + let mCourseId = case result of + FormSuccess (_, Just courseId) -> Just courseId + _ -> Nothing + doCreateResetLink mEmail mCourseId -doCreateResetLink :: Maybe Text -> Handler Html -doCreateResetLink (Just email) = do +doCreateResetLink :: Maybe Text -> Maybe CourseId -> Handler Html +doCreateResetLink (Just email) mCourseId = do mUserEnt <- runDB $ getBy $ UniqueUser email userId <- createOrUse mUserEnt email + addParticipant userId mCourseId + key <- newToken theNow <- liftIO getCurrentTime let expirationMoment = addUTCTime (60*60*24) theNow @@ -39,10 +44,16 @@ doCreateResetLink (Just email) = do setTitle "Creating a reset link" $(widgetFile "reset-link-created") -doCreateResetLink Nothing = do +doCreateResetLink Nothing _ = do setMessage $ toHtml ("No e-mail given" :: Text) getCreateResetLinkR + +addParticipant userId Nothing = return () +addParticipant userId (Just courseId) = do + runDB $ insert $ Participant userId courseId + return () + createOrUse :: Maybe (Entity User) -> Text -> Handler UserId createOrUse (Just userEnt) _ = return $ entityKey userEnt createOrUse Nothing email = do @@ -51,9 +62,17 @@ createOrUse Nothing email = do userId <- runDB $ insert $ User email Nothing Nothing False Nothing True Nothing Nothing Nothing (Just triggerToken) return userId -createResetLinkForm :: Form Text -createResetLinkForm = renderBootstrap3 BootstrapBasicForm - $ areq textField (bfs MsgEMail) Nothing +createResetLinkForm :: Form (Text, Maybe CourseId) +createResetLinkForm = renderBootstrap3 BootstrapBasicForm $ (,) + <$> areq textField (bfs MsgEMail) Nothing + <*> coursesSelectFieldList + +coursesSelectFieldList = aopt (selectField courses) (bfs MsgCourseOptional) Nothing + where + courses = do + courseEnts <- runDB $ selectList [] [Asc CourseName] + optionsPairs $ Import.map (\ch -> (courseName $ entityVal ch, entityKey ch)) courseEnts + getResetPasswordR :: Text -> Handler Html getResetPasswordR key = do diff --git a/config/models b/config/models index daeb2d2..6992185 100644 --- a/config/models +++ b/config/models @@ -108,4 +108,8 @@ Course closed Bool UniqueCourseName name UniqueCourseCode code +Participant + user UserId + course CourseId + UniqueUserCourse user course -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/messages/en.msg b/messages/en.msg index 5e4a8f1..e200433 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -50,3 +50,4 @@ PasswordForNewAccount: enter a password for your new account SubmissionDescriptionTooltip: the first non-empty line of the commit message will be used, if this is left empty Challenge: challenge Course: course +CourseOptional: course (optional)