fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/error/de-de-formal.msg
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. 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. 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. 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.

2
messages/uniworx/categories/error/en-eu.msg
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. 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. 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. 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.

28
src/Handler/Tutorial/Users.hs
View File

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