course can be given

This commit is contained in:
Filip Gralinski 2017-10-20 09:49:37 +02:00
parent c1f8e2d83e
commit 6aba6be745
3 changed files with 32 additions and 8 deletions

View File

@ -21,15 +21,20 @@ postCreateResetLinkR :: Handler Html
postCreateResetLinkR = do postCreateResetLinkR = do
((result, _), _) <- runFormPost createResetLinkForm ((result, _), _) <- runFormPost createResetLinkForm
let mEmail = case result of let mEmail = case result of
FormSuccess email -> Just email FormSuccess (email, _) -> Just email
_ -> Nothing _ -> Nothing
doCreateResetLink mEmail let mCourseId = case result of
FormSuccess (_, Just courseId) -> Just courseId
_ -> Nothing
doCreateResetLink mEmail mCourseId
doCreateResetLink :: Maybe Text -> Handler Html doCreateResetLink :: Maybe Text -> Maybe CourseId -> Handler Html
doCreateResetLink (Just email) = do doCreateResetLink (Just email) mCourseId = do
mUserEnt <- runDB $ getBy $ UniqueUser email mUserEnt <- runDB $ getBy $ UniqueUser email
userId <- createOrUse mUserEnt email userId <- createOrUse mUserEnt email
addParticipant userId mCourseId
key <- newToken key <- newToken
theNow <- liftIO getCurrentTime theNow <- liftIO getCurrentTime
let expirationMoment = addUTCTime (60*60*24) theNow let expirationMoment = addUTCTime (60*60*24) theNow
@ -39,10 +44,16 @@ doCreateResetLink (Just email) = do
setTitle "Creating a reset link" setTitle "Creating a reset link"
$(widgetFile "reset-link-created") $(widgetFile "reset-link-created")
doCreateResetLink Nothing = do doCreateResetLink Nothing _ = do
setMessage $ toHtml ("No e-mail given" :: Text) setMessage $ toHtml ("No e-mail given" :: Text)
getCreateResetLinkR getCreateResetLinkR
addParticipant userId Nothing = return ()
addParticipant userId (Just courseId) = do
runDB $ insert $ Participant userId courseId
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 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) userId <- runDB $ insert $ User email Nothing Nothing False Nothing True Nothing Nothing Nothing (Just triggerToken)
return userId return userId
createResetLinkForm :: Form Text createResetLinkForm :: Form (Text, Maybe CourseId)
createResetLinkForm = renderBootstrap3 BootstrapBasicForm createResetLinkForm = renderBootstrap3 BootstrapBasicForm $ (,)
$ areq textField (bfs MsgEMail) Nothing <$> 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 :: Text -> Handler Html
getResetPasswordR key = do getResetPasswordR key = do

View File

@ -108,4 +108,8 @@ Course
closed Bool closed Bool
UniqueCourseName name UniqueCourseName name
UniqueCourseCode code 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) -- By default this file is used in Model.hs (which is imported by Foundation.hs)

View File

@ -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 SubmissionDescriptionTooltip: the first non-empty line of the commit message will be used, if this is left empty
Challenge: challenge Challenge: challenge
Course: course Course: course
CourseOptional: course (optional)