From 19012abd38661de7e288d2e76c78cfb6cedf3a83 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 17 Jan 2023 15:53:59 +0100
Subject: [PATCH] chore(users): add action to remove all supervisors

---
 messages/uniworx/categories/user/de-de-formal.msg | 6 ++++--
 messages/uniworx/categories/user/en-eu.msg        | 6 ++++--
 src/Foundation/I18n.hs                            | 4 ++++
 src/Handler/Users.hs                              | 7 ++++++-
 4 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg
index e56ae4cff..9ebd9ddfa 100644
--- a/messages/uniworx/categories/user/de-de-formal.msg
+++ b/messages/uniworx/categories/user/de-de-formal.msg
@@ -90,9 +90,11 @@ AllUsersLdapSync: Alle LDAP-Synchronisieren
 UserHijack: Sitzung übernehmen
 UserAddSupervisor: Ansprechpartner hinzufügen
 UserSetSupervisor: Ansprechpartner ersetzen
+UserRemoveSupervisor: Alle Ansprechpartner entfernen
 AuthKindLDAP: Fraport AG Kennung
 AuthKindPWHash: FRADrive Kennung
 AuthKindNoLogin: Kein Login möglich
 Name !ident-ok: Name
-UsersChangeSupervisorsSuccess usr@Int spr@Int: #{tshow spr} Ansprechpartner für #{tshow usr} Benutzer gesetzt
-UsersChangeSupervisorsWarning usr@Int spr@Int bad@Int: Nur #{tshow spr} Ansprechpartner für #{tshow usr} Benutzer gesetzt. #{tshow bad} Ansprechpartner wurden nicht gefunden!
+UsersChangeSupervisorsSuccess usr@Int spr@Int: #{tshow spr} Ansprechpartner für #{tshow usr} Benutzer gesetzt.
+UsersChangeSupervisorsWarning usr@Int spr@Int bad@Int: Nur _{MsgUsersChangeSupervisorsSuccess usr spr} #{tshow bad} Ansprechpartner #{pluralDE bad "wurde" "wurden"} nicht gefunden!
+UsersRemoveSupervisors usr@Int: Alle Ansprechpartner für #{tshow usr} Benutzer gelöscht.
diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg
index 9e55977d0..7b86db0d9 100644
--- a/messages/uniworx/categories/user/en-eu.msg
+++ b/messages/uniworx/categories/user/en-eu.msg
@@ -90,9 +90,11 @@ AllUsersLdapSync: Synchronise all with LDAP
 UserHijack: Hijack session
 UserAddSupervisor: Add supervisor
 UserSetSupervisor: Replace supervisors
+UserRemoveSupervisor: Set to unsupervised
 AuthKindLDAP: Fraport AG account
 AuthKindPWHash: FRADrive account
 AuthKindNoLogin: No login
 Name: Name
-UsersChangeSupervisorsSuccess usr@Int spr@Int: #{tshow spr} Supervisors for #{tshow usr} Users  set
-UsersChangeSupervisorsWarning usr@Int spr@Int bad@Int: Nur #{tshow spr} Supervisors for #{tshow usr} Users set. #{tshow bad} Supervisors could not be identified!
+UsersChangeSupervisorsSuccess usr spr: #{pluralENsN spr "supervisor"} for #{pluralENsN usr "user"} set.
+UsersChangeSupervisorsWarning usr spr bad: Only _{MsgUsersChangeSupervisorsSuccess usr spr} #{pluralENsN bad "supervisors"} could not be identified!
+UsersRemoveSupervisors usr: Removed all supervisors for #{pluralENsN usr "user"}.
\ No newline at end of file
diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs
index e1294a102..122b77cae 100644
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@@ -115,6 +115,10 @@ pluralENs :: (Eq a, Num a)
 -- ^ @pluralENs n "foo" = pluralEN n "foo" "foos"@ 
 pluralENs n t = pluralEN n t $ t `snoc` 's'
 
+-- | like `pluralENs` but also prefixes with the number
+pluralENsN :: (Eq a, Num a, Show a) => a -> Text -> Text
+pluralENsN n t = tshow n <> cons ' ' (pluralENs n t)
+
 noneOneMoreEN :: (Eq a, Num a)
               =>    a -- ^ Count
               -> Text -- ^ None
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index c1185e758..80225946f 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -55,7 +55,7 @@ hijackUserForm csrf = do
 -- instance HasUser   (DBRow (Entity USer)) where
 --    hasUser = _entityVal
 
-data UserAction = UserLdapSync | UserAddSupervisor | UserSetSupervisor
+data UserAction = UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
@@ -66,6 +66,7 @@ data UserActionData = UserLdapSyncData
                     | UserHijack
                     | UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool } 
                     | UserSetSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool }
+                    | UserRemoveSupervisorData
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   
 isNotSetSupervisor :: UserActionData -> Bool
@@ -192,6 +193,7 @@ postUsersR = do
         , singletonMap UserSetSupervisor $ UserSetSupervisorData 
             <$> apopt  (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
+        , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
         ]
 
     over _1 postprocess <$> dbTable psValidator DBTable
@@ -339,6 +341,9 @@ postUsersR = do
       redirect UsersR
     (UserHijack, Set.minView -> Just (uid, _)) ->
       hijackUser uid >>= sendResponse
+    (UserRemoveSupervisorData, userSet) -> do      
+      runDB $ deleteWhere [UserSupervisorUser <-. Set.toList userSet]
+      addMessageI Success $ MsgUsersRemoveSupervisors $ Set.size userSet
     (act, usersSet)
       | isActionSupervisor act -> do 
         avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet upsertAvsUser $ getActionSupervisors act