From f64b985d35cf8a9336acdbd1866468b8e0265c0c Mon Sep 17 00:00:00 2001
From: Steffen Jost <s.jost@fraport.de>
Date: Thu, 25 May 2023 11:15:47 +0000
Subject: [PATCH 1/2] chore(messages): fix typo in
 categories/qualification/de-de-formal.msg

---
 messages/uniworx/categories/qualification/de-de-formal.msg | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg
index 22379aa46..3fbef045b 100644
--- a/messages/uniworx/categories/qualification/de-de-formal.msg
+++ b/messages/uniworx/categories/qualification/de-de-formal.msg
@@ -47,7 +47,7 @@ TableLmsStarted: Begonnen
 TableLmsReceived: Letzte Rückmeldung
 TableLmsNotified: Versand Benachrichtigung
 TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E‑Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
-TableLmsEnded: Beended
+TableLmsEnded: Beendet
 TableLmsStatus: Status E‑Learning
 TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt #{maybeToMessage "bis zu " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss"} den letzten Zustand eines E‑Learnings an:
 TableLmsStatusDay: Datum letzte Statusänderung E‑Learning

From 3cb66c6211b9f15127d88f448557acb4a3a2dd5c Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Fri, 26 May 2023 08:34:02 +0000
Subject: [PATCH 2/2] fix(qualifications): fix #78 block/unblock no longer
 deletes company association

---
 .../categories/qualification/de-de-formal.msg       |  1 +
 messages/uniworx/categories/qualification/en-eu.msg |  1 +
 src/Handler/Qualification.hs                        | 13 +++++++++----
 3 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg
index 3fbef045b..77f754e62 100644
--- a/messages/uniworx/categories/qualification/de-de-formal.msg
+++ b/messages/uniworx/categories/qualification/de-de-formal.msg
@@ -32,6 +32,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
 QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
 QualificationBlockReason: Entzugsbegründung
 QualificationBlockNotify: Benachrichtigung verschicken
+QualificationBlockRemoveSupervisor: Alle Ansprechpartner löschen
 QualificationExpired: Ungültig seit
 LmsUser: Inhaber
 LmsURL: Link E‑Learning
diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg
index 0557da13a..57dcf853b 100644
--- a/messages/uniworx/categories/qualification/en-eu.msg
+++ b/messages/uniworx/categories/qualification/en-eu.msg
@@ -32,6 +32,7 @@ QualificationUserNoRenewal: Expires without further notification
 QualificationUserNone: No registered qualifications for this person.
 QualificationBlockReason: Reason for revoking
 QualificationBlockNotify: Send notification
+QualificationBlockRemoveSupervisor: Remove all supervisors
 QualificationExpired: Expired on
 LmsUser: Licensee
 LmsURL: Link E-learning
diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs
index 39fd2dd33..a1863add9 100644
--- a/src/Handler/Qualification.hs
+++ b/src/Handler/Qualification.hs
@@ -269,7 +269,7 @@ data QualificationTableActionData
   = QualificationActExpireData 
   | QualificationActUnexpireData  
   | QualificationActBlockSupervisorData
-  | QualificationActBlockData           { qualTableActBlockReason :: Text, qualTableActNotify :: Bool }
+  | QualificationActBlockData           { qualTableActBlockReason :: Text, qualTableActNotify :: Bool, qualTableActRemoveSupervisors :: Bool }
   | QualificationActUnblockData
   | QualificationActRenewData
   | QualificationActGrantData           { qualTableActGrantUntil  :: Day }   
@@ -286,6 +286,11 @@ isBlockAct QualificationActBlockData{}          = True
 isBlockAct QualificationActUnblockData          = True
 isBlockAct _ = False
 
+blockActRemoveSupervisors :: QualificationTableActionData -> Bool
+blockActRemoveSupervisors QualificationActBlockSupervisorData  = True
+blockActRemoveSupervisors QualificationActBlockData{qualTableActRemoveSupervisors=res} = res
+blockActRemoveSupervisors _ = False
+
 qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
   -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
                 , E.SqlExpr (Entity User)
@@ -491,7 +496,8 @@ postQualificationR sid qsh = do
           [ singletonMap QualificationActUnblock         $ pure QualificationActUnblockData           -- Admin-only actions
           , singletonMap QualificationActBlock           $      QualificationActBlockData 
               <$> apreq textField (fslI MsgQualificationBlockReason) Nothing
-              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False)
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify)            (Just False)
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockRemoveSupervisor)  (Just False)
           , singletonMap QualificationActRenew           $ pure QualificationActRenewData
           , singletonMap QualificationActGrant           $      QualificationActGrantData 
                 <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
@@ -562,8 +568,7 @@ postQualificationR sid qsh = do
               _ -> False
           
       oks <- runDB $ do 
-        deleteWhere [UserSupervisorUser <-. selUserIds]
-        deleteWhere [UserCompanyUser    <-. selUserIds]
+        when (blockActRemoveSupervisors action) $ deleteWhere [UserSupervisorUser <-. selUserIds]
         qualificationUserBlocking qid selUserIds notify qubr
       let nrq = length selectedUsers
           warnLevel = if