chore(tutorial): ensure that course qualification form actions are stll valid upon reception

This commit is contained in:
Steffen Jost 2023-03-06 17:59:00 +00:00
parent ffaaf9c86d
commit 5eb14c8512
3 changed files with 20 additions and 12 deletions

View File

@ -6,3 +6,5 @@ ErrorResponseNotFound: Unter der von Ihrem Browser angefragten URL wurde keine S
ErrorResponseNotAuthenticated: Um Zugriff auf einige Teile des Systems zu erhalten müssen Sie sich zunächst anmelden.
ErrorResponseBadMethod requestMethodText@Text: Ihr Browser kann auf mehrere verschiedene Arten versuchen mit den vom System angebotenen Ressourcen zu interagieren. Die aktuell versuchte Methode (#{requestMethodText}) wird nicht unterstützt.
ErrorResponseEncrypted: Um keine sensiblen Daten preiszugeben wurden nähere Details verschlüsselt. Wenn Sie eine Anfrage an den Support schicken fügen Sie bitte die unten aufgeführten verschlüsselten Daten mit an.
ErrorUnknownFormAction: Unbekannte oder ungültige Formular Aktion wurde ignoriert.

View File

@ -6,3 +6,5 @@ ErrorResponseNotFound: No page could be found under the url requested by your br
ErrorResponseNotAuthenticated: To be granted access to most parts of Uni2work you need to login first.
ErrorResponseBadMethod requestMethodText: Your browser can interact in multiple ways with the resources offered by Uni2work. The requested method (#{requestMethodText}) is not supported here.
ErrorResponseEncrypted: In order not to reveal sensitive information further details have been encrypted. If you send a support request, please include the encrypted data listed below.
ErrorUnknownFormAction: Unknown or invalid form action was ignored.

View File

@ -56,7 +56,7 @@ getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName
getTUsersR = postTUsersR
postTUsersR tid ssh csh tutn = do
showSex <- getShowSex
(Entity tutid Tutorial{..}, (participantRes, participantTable)) <- runDB $ do
(Entity tutid Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
-- qualifications <- selectList [QualificationSchool ==. ssh] [Asc QualificationShorthand]
@ -116,19 +116,22 @@ postTUsersR tid ssh csh tutn = do
, ( TutorialUserDeregister, pure TutorialUserDeregisterData )
]
table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices)
return (tut, table)
return (tut, table, qualifications)
let courseQids = Set.fromList (entityKey <$> qualifications)
formResult participantRes $ \case
(TutorialUserGrantQualificationData{..}, selectedUsers) -> do
-- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
today <- utctDay <$> liftIO getCurrentTime
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserRenewQualificationData{..}, selectedUsers) -> do
noks <- runDB $ renewValidQualificationUsers tuQualification $ Set.toList selectedUsers
addMessageI (if noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserGrantQualificationData{..}, selectedUsers)
| tuQualification `Set.member` courseQids -> do
-- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
today <- utctDay <$> liftIO getCurrentTime
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserRenewQualificationData{..}, selectedUsers)
| tuQualification `Set.member` courseQids -> do
noks <- runDB $ renewValidQualificationUsers tuQualification $ Set.toList selectedUsers
addMessageI (if noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserSendMailData{}, selectedUsers) -> do
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
redirect (CTutorialR tid ssh csh tutn TCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
@ -139,6 +142,7 @@ postTUsersR tid ssh csh tutn = do
]
addMessageI Success $ MsgTutorialUsersDeregistered nrDel
redirect $ CTutorialR tid ssh csh tutn TUsersR
_other -> addMessageI Error MsgErrorUnknownFormAction
tutors <- runDB $ E.select $ do
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User