From eb541b4e91ecf86f7cba1c3b080675543a1f1dbd Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 28 Nov 2023 18:54:16 +0100 Subject: [PATCH] chore(firm): add action to change individual supervisors --- .../uniworx/categories/firm/de-de-formal.msg | 4 ++ messages/uniworx/categories/firm/en-eu.msg | 4 ++ .../send/send_notifications/de-de-formal.msg | 2 +- .../send/send_notifications/en-eu.msg | 2 +- src/Handler/Firm.hs | 43 ++++++++++++++++--- 5 files changed, 48 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 0d872dba0..2772c864a 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -24,6 +24,10 @@ FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Fi FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft nur neue Firmenangehörige ohne eigene Kontaktinformationen FirmUserActNotify: Mitteilung versenden FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen +FirmUserActSetSupervisor: Ansprechpartner ändern +FirmNewSupervisor: Neue individuelle Ansprechpartner hinzufügen +FirmSetSupervisor: Existierende Ansprechpartner hinzufügen +FirmSetSupersReport nusr@Int64 nspr@Int64 nrem@Int64: Für #{nusr} Firmenangehörige wurden #{nspr} individuelle Ansprechpartner eingetragen#{bool "." (" und " <> tshow nrem <> " individuelle Ansprechpartnerbeziehungen gelöscht.") (nrem >0)} FirmUserActMkSuper: Zum Firmenansprechpartner ernennen FirmUserActChangeContact: Kontaktinformationen für ausgewählte Firmenangehörige ändern FirmResetSupervision rem@Int64 set@Int64: #{tshow set} Ansprechpartner gesetzt#{bool mempty (", " <> tshow rem <> " zuvor gelöscht") (rem > 0)} diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 0554ce6e9..a91186f6e 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -24,6 +24,10 @@ FirmActChangeContactFirmInfo: The company contact data is only used for new comp FirmActChangeContactFirmResult: Company contact data changed, affecting future company associates without contact information only FirmUserActNotify: Send message FirmUserActResetSupervision: Reset supervisors to company default +FirmUserActSetSupervisor: Change supervision +FirmNewSupervisor: Appoint new individual supervisors +FirmSetSupervisor: Add existing supervisors +FirmSetSupersReport nusr@Int64 nspr@Int64 nrem@Int64: #{nspr} individal supervisors set for #{nusr} company associates#{bool "." (" and " <> tshow nrem <> " other individual supervisions terminated.") (nrem >0)} FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)} FirmUserActChangeContact: Change contact data for selected company associates FirmUserActMkSuper: Mark as company supervisor diff --git a/messages/uniworx/categories/send/send_notifications/de-de-formal.msg b/messages/uniworx/categories/send/send_notifications/de-de-formal.msg index b2a350b3e..cba2c8110 100644 --- a/messages/uniworx/categories/send/send_notifications/de-de-formal.msg +++ b/messages/uniworx/categories/send/send_notifications/de-de-formal.msg @@ -103,4 +103,4 @@ MailSupervisorNoCopy: Warnung: Diese Nachricht wurde nicht an den eigentlichen E MailSupervisedNote: Hinweis MailSupervisedBody: Eine Kopie dieser Nachricht wurde auch an folgende in FRADrive eingetragene Ansprechpartner gesendet: MailSupervisorReroute: Benachrichtigungsumleitung -MailSupervisorRerouteTooltip: Alle Benachrichtigungen werden stattdessen an alle Ansprechpartner mit Benachrichtigungsumleitung gesandt \ No newline at end of file +MailSupervisorRerouteTooltip: Alle Benachrichtigungen werden stattdessen an diese Ansprechpartner mit Benachrichtigungsumleitung gesandt \ No newline at end of file diff --git a/messages/uniworx/categories/send/send_notifications/en-eu.msg b/messages/uniworx/categories/send/send_notifications/en-eu.msg index b06a1c2eb..04fe30088 100644 --- a/messages/uniworx/categories/send/send_notifications/en-eu.msg +++ b/messages/uniworx/categories/send/send_notifications/en-eu.msg @@ -103,4 +103,4 @@ MailSupervisorNoCopy: Warning: This message was not sent to the original recipie MailSupervisedNote: Please note MailSupervisedBody: A copy of this message has been sent to all supervisors registered for you in FRADrive, namely: MailSupervisorReroute: Reroute notifications -MailSupervisorRerouteTooltip: All notification will be sent to all supervisors with notification rerouting instead \ No newline at end of file +MailSupervisorRerouteTooltip: All notification will be rerouted to these supervisors instead \ No newline at end of file diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index eb95a1e40..547c4e07c 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -664,6 +664,7 @@ postFirmAllR = do data FirmUserAction = FirmUserActNotify | FirmUserActResetSupervision + | FirmUserActSetSupervisor | FirmUserActMkSuper | FirmUserActChangeContact deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) @@ -672,11 +673,17 @@ data FirmUserAction = FirmUserActNotify nullaryPathPiece ''FirmUserAction $ camelToPathPiece' 3 embedRenderMessage ''UniWorX ''FirmUserAction id -data FirmUserActionData = FirmUserActNotifyData +data FirmUserActionData = FirmUserActNotifyData | FirmUserActResetSupervisionData { firmUserActResetKeepOldSupers :: Maybe Bool -- , firmUserActResetMutualSupervision :: Maybe Bool } + | FirmUserActSetSupervisorData + { firmUserActSetSuperNames :: Set Text + , firmUserActSetSuperIds :: [UserId] + , firmUserActSetSuperReroute :: Bool + , firmUserActSetSuperKeep :: Bool + } | FirmUserActMkSuperData { firmUserActMkSuperReroute :: Maybe Bool } | FirmUserActChangeContactData @@ -831,6 +838,11 @@ mkFirmUserTable isAdmin cid = do , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False) -- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) + , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData + <$> apopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <*> apopt supervisorsField (fslI MsgFirmSetSupervisor) Nothing + <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False) + <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True) , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData @@ -904,10 +916,6 @@ postFirmUsersR fsh = do formResult fusrRes $ \case (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice - (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do - nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)] - addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing - reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes (FirmUserActNotifyData , uids) -> do cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser] redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) @@ -919,6 +927,31 @@ postFirmUsersR fsh = do newSupers <- addDefaultSupervisors cid uids addMessageI Info $ MsgFirmResetSupervision delSupers newSupers reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes + (FirmUserActSetSupervisorData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do + avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmUserActSetSuperNames + let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers + usersFound = mapMaybe snd usersFound' + newSupers = Set.toList $ Set.fromList firmUserActSetSuperIds <> Set.fromList usersFound + nrSupers = fromIntegral $ length newSupers + nrUsers = fromIntegral $ length uids + unless (null usersNotFound) $ + let msgContent = [whamlet| + $newline never +