From 5eb14c85122d2511c3a3d59aafc8953bbb4563a9 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Mon, 6 Mar 2023 17:59:00 +0000
Subject: [PATCH] chore(tutorial): ensure that course qualification form
 actions are stll valid upon reception

---
 .../uniworx/categories/error/de-de-formal.msg |  2 ++
 messages/uniworx/categories/error/en-eu.msg   |  2 ++
 src/Handler/Tutorial/Users.hs                 | 28 +++++++++++--------
 3 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/messages/uniworx/categories/error/de-de-formal.msg b/messages/uniworx/categories/error/de-de-formal.msg
index fc419ed73..5ebda257d 100644
--- a/messages/uniworx/categories/error/de-de-formal.msg
+++ b/messages/uniworx/categories/error/de-de-formal.msg
@@ -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.
\ No newline at end of file
diff --git a/messages/uniworx/categories/error/en-eu.msg b/messages/uniworx/categories/error/en-eu.msg
index 6d22e42db..9b3a3d83a 100644
--- a/messages/uniworx/categories/error/en-eu.msg
+++ b/messages/uniworx/categories/error/en-eu.msg
@@ -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.
\ No newline at end of file
diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs
index e01ff2223..8bbb02ee0 100644
--- a/src/Handler/Tutorial/Users.hs
+++ b/src/Handler/Tutorial/Users.hs
@@ -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