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

fix(supervision): fix #181 by unifying deletion of supervision

Browse Source
This commit is contained in:
Steffen Jost 2024-09-10 17:47:09 +02:00
parent ea113cf57a
commit 6a070a6775
9 changed files with 88 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
messages/uniworx/categories/firm/de-de-formal.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de> # SPDX-FileCopyrightText: 2023-24 Steffen Jost <s.jost@fraport.de>
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # SPDX-License-Identifier: AGPL-3.0-or-later
@ -15,11 +15,15 @@ FirmActionInfo: Betrifft alle Firmenangehörigen unter Ihrer Aufsicht.
FirmActNotify: Mitteilung versenden FirmActNotify: Mitteilung versenden
FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten? FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
FirmActRemoveSupers: Alle rein firmenbezogenen Ansprechpartnerbeziehungen für diese Personen entfernen?
FirmActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig FirmActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
FirmActResetSupersKeepAll: Alle behalten
FirmActResetSupersRemoveAps: Nur Standardansprechpartner entfernen
FirmActResetSupersRemoveAll: Alle entfernen
FirmActAddSupervisors: Ansprechpartner hinzufügen FirmActAddSupervisors: Ansprechpartner hinzufügen
FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner geändert #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert. FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner geändert #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber keine aktiven Ansprechpartnerbeziehungen wurden deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)} RemoveSupervisors ndef@Int64: #{ndef} Standardansprechpartner entfernt.
FirmActChangeContactUser: Kontaktinformationen von allen Firmenangehörigen ändern FirmActChangeContactUser: Kontaktinformationen von allen Firmenangehörigen ändern
FirmActChangeContactFirm: Kontaktinformationen der Firma ändern FirmActChangeContactFirm: Kontaktinformationen der Firma ändern
FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Firmenangehörige verwendet, für die sonst keine Kontaktinformationen vorliegen. FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Firmenangehörige verwendet, für die sonst keine Kontaktinformationen vorliegen.
@ -33,7 +37,8 @@ FirmUserActRemove: Firmenassoziation entfernen
FirmUserActMkSuper: Zum Firmenansprechpartner ernennen FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
FirmUserActChangeDetailsResult n@Int64 t@Int64: Firmenassoziation von #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden aktualisiert FirmUserActChangeDetailsResult n@Int64 t@Int64: Firmenassoziation von #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden aktualisiert
FirmUserActChangeResult n@Int64 t@Int64: Benachrichtigungseinstellung für #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden geändert FirmUserActChangeResult n@Int64 t@Int64: Benachrichtigungseinstellung für #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden geändert
FirmuserActRemoveResult uc@Int64 sup@Int64 sub@Int64: #{uc} #{pluralDE uc "Firmenassoziation" "Firmenassoziationen"} entfernt. #{noneMoreDE sup "" (tshow sup <> "Ansprechpartnerbeziehungen wegen entferntem Ansprechpartner gelöschtt. ")} #{noneMoreDE sub "" (tshow sup <> "Ansprechpartnerbeziehungen wegen entfernten Angesprochenen gelöscht.")} FirmUserActRemoveResult uc@Int64: #{uc} #{pluralDE uc "Firmenassoziation" "Firmenassoziationen"} entfernt.
FirmRemoveSupervision sup@Int64 sub@Int64: #{noneMoreDE sup "" (tshow sup <> " Ansprechpartnerbeziehungen wegen entferntem Ansprechpartner gelöscht. ")} #{noneOneMoreDE sub "Keine Ansprechpartnerbeziehung" "Eine Ansprechpartnerbeziehung" (tshow sup <> " Ansprechpartnerbeziehungen")} wegen entferntem Angesprochenem gelöscht.
FirmNewSupervisor: Neue individuelle Ansprechpartner hinzufügen FirmNewSupervisor: Neue individuelle Ansprechpartner hinzufügen
FirmSetSupervisor: Existierende 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)} 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)}
@ -42,7 +47,7 @@ FirmSuperActNotify: Mitteilung versenden
FirmSuperActSwitchSuper: Standard Firmenansprechpartner abändern FirmSuperActSwitchSuper: Standard Firmenansprechpartner abändern
FirmSuperActSwitchSuperInfo: Betrifft keine firmenfremden Ansprechpartner und ändert keine aktiven individuellen Ansprechpartnerbeziehungen. Gegebenfalls im Anschluss die Funktion "Ansprechpartner auf Firmenstandard zurücksetzen" nutzen. FirmSuperActSwitchSuperInfo: Betrifft keine firmenfremden Ansprechpartner und ändert keine aktiven individuellen Ansprechpartnerbeziehungen. Gegebenfalls im Anschluss die Funktion "Ansprechpartner auf Firmenstandard zurücksetzen" nutzen.
FirmSuperActRMSuperDef: Firmenansprechpartner entfernen FirmSuperActRMSuperDef: Firmenansprechpartner entfernen
FirmSuperActRMSuperActive: Auch aktive Ansprechpartnerbeziehungen innerhalb dieser Firma beenden FirmSuperActRMSuperActive: Aktive Ansprechpartnerbeziehungen innerhalb dieser Firma beenden?
FirmsNotification: Firmen E-Mail versenden FirmsNotification: Firmen E-Mail versenden
FirmNotification fsh@CompanyShorthand: E-Mail an #{fsh} senden FirmNotification fsh@CompanyShorthand: E-Mail an #{fsh} senden
FirmsNotificationTitle: Firmen benachrichtigen FirmsNotificationTitle: Firmen benachrichtigen

13
messages/uniworx/categories/firm/en-eu.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de> # SPDX-FileCopyrightText: 2023-24 Steffen Jost <s.jost@fraport.de>
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # SPDX-License-Identifier: AGPL-3.0-or-later
@ -15,11 +15,15 @@ FirmActionInfo: Affects alle company associates under your supervision.
FirmActNotify: Send message FirmActNotify: Send message
FirmActResetSupervision: Reset supervisors for all company associates FirmActResetSupervision: Reset supervisors for all company associates
FirmActResetSuperKeep: Additionally keep existing supervisors of company associates? FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
FirmActRemoveSupers: Terminate all company related supervisonships?
FirmActResetMutualSupervision: Supervisors supervise each other FirmActResetMutualSupervision: Supervisors supervise each other
FirmActResetSupersKeepAll: Keep all
FirmActResetSupersRemoveAps: Remove default supervisors only
FirmActResetSupersRemoveAll: Remove all
FirmActAddSupervisors: Add supervisors FirmActAddSupervisors: Add supervisors
FirmActAddSupersEmpty: No supervisors added FirmActAddSupersEmpty: No supervisors added
FirmActAddSupersSet n postal: #{n} default company supervisors changed #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated. FirmActAddSupersSet n postal: #{n} default company supervisors changed #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but no active supervisions were deactivated" (" and " <> tshow nact <> " active supervisions terminated") (nact > 0)} RemoveSupervisors ndef: #{ndef} default supervisors removed.
FirmActChangeContactUser: Change contact data for all company associates FirmActChangeContactUser: Change contact data for all company associates
FirmActChangeContactFirm: Change company contact data FirmActChangeContactFirm: Change company contact data
FirmActChangeContactFirmInfo: The company contact data is only used for new company associates that would habe no contact information of their own otherwise. FirmActChangeContactFirmInfo: The company contact data is only used for new company associates that would habe no contact information of their own otherwise.
@ -33,7 +37,8 @@ FirmUserActRemove: Delete company association
FirmUserActMkSuper: Mark as company supervisor FirmUserActMkSuper: Mark as company supervisor
FirmUserActChangeDetailsResult n t: #{n}/#{t} #{pluralENs n "company association"} updated FirmUserActChangeDetailsResult n t: #{n}/#{t} #{pluralENs n "company association"} updated
FirmUserActChangeResult n t: Notification settings changed for #{n}/#{t} company #{pluralENs n "associate"} FirmUserActChangeResult n t: Notification settings changed for #{n}/#{t} company #{pluralENs n "associate"}
FirmuserActRemoveResult uc sup sub: #{pluralENsN uc "Company association"} deleted. #{noneMoreEN sup "" ((pluralENsN sup "supervision") <> " removed due to eliminated supervisors.")} #{noneMoreEN sub "" ((pluralENsN sub "supervision") <> " removed due to eliminated supervisees.")} FirmUserActRemoveResult uc: #{pluralENsN uc "Company association"} deleted.
FirmRemoveSupervision sup sub: #{noneMoreEN sup "" ((pluralENsN sup "supervision") <> " removed due to eliminated supervisors.")} #{noneMoreEN sub "No supervision" (pluralENsN sub "supervision")} removed due to eliminated supervisees.
FirmNewSupervisor: Appoint new individual supervisors FirmNewSupervisor: Appoint new individual supervisors
FirmSetSupervisor: Add existing supervisors FirmSetSupervisor: Add existing supervisors
FirmSetSupersReport nusr nspr nrem: #{nspr} individual supervisors set for #{nusr} company associates#{bool "." (" and " <> tshow nrem <> " other individual supervisions terminated.") (nrem >0)} FirmSetSupersReport nusr nspr nrem: #{nspr} individual supervisors set for #{nusr} company associates#{bool "." (" and " <> tshow nrem <> " other individual supervisions terminated.") (nrem >0)}
@ -42,7 +47,7 @@ FirmSuperActNotify: Send message
FirmSuperActSwitchSuper: Change default company supervisor FirmSuperActSwitchSuper: Change default company supervisor
FirmSuperActSwitchSuperInfo: Does not affect company-external supervisors and does not change any active individual supervisions. Additionally use reset action, if desired. FirmSuperActSwitchSuperInfo: Does not affect company-external supervisors and does not change any active individual supervisions. Additionally use reset action, if desired.
FirmSuperActRMSuperDef: Remove default supervisor FirmSuperActRMSuperDef: Remove default supervisor
FirmSuperActRMSuperActive: Also remove active supervisions within this company FirmSuperActRMSuperActive: Terminate active supervisions within this company?
FirmsNotification: Send company notification e-mail FirmsNotification: Send company notification e-mail
FirmNotification fsh: Send e-mail to #{fsh} FirmNotification fsh: Send e-mail to #{fsh}
FirmsNotificationTitle: Company notification FirmsNotificationTitle: Company notification

94
src/Handler/Firm.hs
View File

@ -742,29 +742,28 @@ embedRenderMessage ''UniWorX ''FirmUserAction id
data FirmUserActionData = FirmUserActNotifyData data FirmUserActionData = FirmUserActNotifyData
| FirmUserActResetSupervisionData | FirmUserActResetSupervisionData
{ firmUserActResetKeepOldSupers :: Maybe Bool { firmUserActResetSupers :: Maybe Bool
-- , firmUserActResetMutualSupervision :: Maybe Bool
} }
| FirmUserActSetSupervisorData | FirmUserActSetSupervisorData
{ firmUserActSetSuperNames :: Maybe (Set Text) { firmUserActSetSuperNames :: Maybe (Set Text)
, firmUserActSetSuperIds :: Maybe [UserId] , firmUserActSetSuperIds :: Maybe [UserId]
, firmUserActSetSuperReason :: Maybe Text , firmUserActSetSuperReason :: Maybe Text
, firmUserActSetSuperReroute :: Bool , firmUserActSetSuperReroute :: Bool
, firmUserActSetSuperKeep :: Bool , firmUserActResetSupers :: Maybe Bool
} }
| FirmUserActMkSuperData | FirmUserActMkSuperData
{ firmUserActMkSuperReroute :: Maybe Bool } { firmUserActMkSuperReroute :: Maybe Bool }
| FirmUserActChangeDetailsData | FirmUserActChangeDetailsData
{ firmUserActDetailPriority :: Maybe Int { firmUserActDetailPriority :: Maybe Int
, firmUserActDetailReason :: Maybe Text , firmUserActDetailReason :: Maybe Text
} }
| FirmUserActChangeContactData | FirmUserActChangeContactData
{ firmUserActPostalAddr :: Maybe StoredMarkup { firmUserActPostalAddr :: Maybe StoredMarkup
, firmUserActUseCompanyPostal :: Maybe Bool , firmUserActUseCompanyPostal :: Maybe Bool
, firmUserActPostalPref :: Maybe Bool , firmUserActPostalPref :: Maybe Bool
} }
| FirmUserActRemoveData | FirmUserActRemoveData
{ firmUserActRemoveKeepSuper :: Bool { firmUserActRemoveSupers :: Bool
} }
deriving (Eq, Ord, Show, Generic) deriving (Eq, Ord, Show, Generic)
@ -968,25 +967,24 @@ mkFirmUserTable isAdmin cid = do
acts = mconcat acts = mconcat
[ guardMonoid isAdmin $ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData [ guardMonoid isAdmin $ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData
, singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False) <$> aopt (boolFieldCustom (SomeMessage MsgFirmActResetSupersRemoveAll) (SomeMessage MsgFirmActResetSupersRemoveAps) $ Just $ SomeMessage MsgFirmActResetSupersKeepAll) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
-- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
, singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
<$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> aopt supervisorsField (fslI MsgFirmSetSupervisor & setTooltip MsgMultiSelectTip) Nothing <*> aopt supervisorsField (fslI MsgFirmSetSupervisor & setTooltip MsgMultiSelectTip) Nothing
<*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing <*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False) <*> areq boolField' (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) <*> aopt (boolFieldCustom (SomeMessage MsgFirmActResetSupersRemoveAll) (SomeMessage MsgFirmActResetSupersRemoveAps) $ Just $ SomeMessage MsgFirmActResetSupersKeepAll) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
<$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True) <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
, singletonMap FirmUserActChangeDetails $ FirmUserActChangeDetailsData
<$> aopt intField (fslI MsgCompanyUserPriority & setTooltip MsgCompanyUserPriorityTip) Nothing
<*> aopt (textField & cfStrip & addDatalist userReasons) (fslI MsgUserCompanyReason & setTooltip (SomeMessages [SomeMessage MsgUserCompanyReasonTooltip, SomeMessage MsgNullDeletes])) Nothing
, singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
<$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing <$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
<*> aopt boolField' (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) Nothing <*> aopt boolField' (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing <*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
, singletonMap FirmUserActChangeDetails $ FirmUserActChangeDetailsData
<$> aopt intField (fslI MsgCompanyUserPriority & setTooltip MsgCompanyUserPriorityTip) Nothing
<*> aopt (textField & cfStrip & addDatalist userReasons) (fslI MsgUserCompanyReason & setTooltip (SomeMessages [SomeMessage MsgUserCompanyReasonTooltip, SomeMessage MsgNullDeletes])) Nothing
, singletonMap FirmUserActRemove $ FirmUserActRemoveData , singletonMap FirmUserActRemove $ FirmUserActRemoveData
<$> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) <$> areq boolField' (fslI MsgFirmActRemoveSupers) (Just True)
] ]
dbtParams = DBParamsForm dbtParams = DBParamsForm
{ dbParamsFormMethod = POST { dbParamsFormMethod = POST
@ -1053,6 +1051,10 @@ postFirmUsersR fsh = do
-- return usr -- return usr
<*> mkFirmUserTable isAdmin cid <*> mkFirmUserTable isAdmin cid
let resetSupers :: Maybe Bool -> NonEmpty UserId -> DB Int64
resetSupers Nothing _ = return 0
resetSupers (Just False) uids = deleteDefaultSupervisorsForUsers [] [] uids
resetSupers (Just True ) uids = deleteWhereCount [UserSupervisorUser <-. toList uids]
formResult fusrRes $ \case formResult fusrRes $ \case
(_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
(FirmUserActNotifyData , uids) -> do (FirmUserActNotifyData , uids) -> do
@ -1060,9 +1062,7 @@ postFirmUsersR fsh = do
redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
(FirmUserActResetSupervisionData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do -- set guaranteed to be non-empty due to first case clause (FirmUserActResetSupervisionData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do -- set guaranteed to be non-empty due to first case clause
runDB $ do runDB $ do
delSupers <- if firmUserActResetKeepOldSupers == Just False delSupers <- resetSupers firmUserActResetSupers uids
then deleteDefaultSupervisorsForUsers [] [] uids
else return 0
newSupers <- addDefaultSupervisors Nothing cid uids newSupers <- addDefaultSupervisors Nothing cid uids
addMessageI Info $ MsgFirmResetSupervision delSupers newSupers addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
@ -1081,8 +1081,7 @@ postFirmUsersR fsh = do
<li>#{usr} <li>#{usr}
|] |]
in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent) in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
delSupers <- runDB delSupers <- runDB $ resetSupers firmUserActResetSupers uids
$ bool (deleteDefaultSupervisorsForUsers [cid] [] uids) (return 0) firmUserActSetSuperKeep
<* putMany [UserSupervisor s u firmUserActSetSuperReroute (Just cid) firmUserActSetSuperReason | u <- toList uids, s <- newSupers] <* putMany [UserSupervisor s u firmUserActSetSuperReroute (Just cid) firmUserActSetSuperReason | u <- toList uids, s <- newSupers]
addMessageI Success $ MsgFirmSetSupersReport nrUsers nrSupers delSupers addMessageI Success $ MsgFirmSetSupersReport nrUsers nrSupers delSupers
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
@ -1119,11 +1118,15 @@ postFirmUsersR fsh = do
allok = bool Warning Success $ nrChanged == total allok = bool Warning Success $ nrChanged == total
addMessageI allok $ MsgFirmUserActChangeResult nrChanged total addMessageI allok $ MsgFirmUserActChangeResult nrChanged total
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
(FirmUserActRemoveData{}, Set.toList -> uids) -> do (FirmUserActRemoveData{..}, Set.toList -> uids) -> do
(nrUc, nrSuper, nrSubs) <- runDB $ deleteCompanyUser cid uids let optRemove = if firmUserActRemoveSupers then id else const $ return 0
(nrUc, nrSuper, nrSubs) <- runDB $ (,,)
<$> deleteWhereCount [UserCompanyCompany ==. cid, UserCompanyUser <-. uids]
<*> optRemove (deleteWhereCount [UserSupervisorCompany ==. Just cid, UserSupervisorSupervisor <-. uids])
<*> optRemove (deleteWhereCount [UserSupervisorCompany ==. Just cid, UserSupervisorUser <-. uids])
let total = fromIntegral $ length uids let total = fromIntegral $ length uids
allok = bool Warning Success $ nrUc == total allok = bool Warning Success $ total == nrUc
addMessageI allok $ MsgFirmuserActRemoveResult nrUc nrSuper nrSubs addMessageI allok $ someMessages [MsgFirmUserActRemoveResult nrUc, MsgFirmRemoveSupervision nrSuper nrSubs]
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupervisors, FirmActChangeContactFirm, FirmActChangeContactUser] formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupervisors, FirmActChangeContactFirm, FirmActChangeContactUser]
@ -1153,7 +1156,7 @@ data FirmSuperActionData = FirmSuperActNotifyData
, firmSuperActSwitchReroute :: Maybe Bool , firmSuperActSwitchReroute :: Maybe Bool
} }
| FirmSuperActRMSuperDefData | FirmSuperActRMSuperDefData
{ firmSuperActRMSuperActive :: Maybe Bool } { firmSuperActRMSuperActive :: Bool }
deriving (Eq, Ord, Show, Generic) deriving (Eq, Ord, Show, Generic)
@ -1296,11 +1299,11 @@ mkFirmSuperTable isAdmin cid = do
acts = mconcat acts = mconcat
[ guardMonoid isAdmin $ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData [ guardMonoid isAdmin $ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData
, singletonMap FirmSuperActSwitchSuper $ FirmSuperActSwitchSuperData , singletonMap FirmSuperActSwitchSuper $ FirmSuperActSwitchSuperData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmSuperDefault) (Just $ Just True) <$> aopt boolField' (fslI MsgFirmSuperDefault) (Just $ Just True)
<*> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultReroute) Nothing <*> aopt boolField' (fslI MsgTableIsDefaultReroute) Nothing
<* aformMessage msgSupervisorUnchanged <* aformMessage msgSupervisorUnchanged
, singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData , singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData
<$> aopt checkBoxField (fslI MsgFirmSuperActRMSuperActive) (Just $ Just True) <$> areq boolField' (fslI MsgFirmSuperActRMSuperActive) (Just True)
] ]
dbtParams = DBParamsForm dbtParams = DBParamsForm
{ dbParamsFormMethod = POST { dbParamsFormMethod = POST
@ -1344,19 +1347,14 @@ postFirmSupersR fsh = do
formResult fsprRes $ \case formResult fsprRes $ \case
(_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
(FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do (FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do
(nrRmSuper,nrRmActual) <- runDB $ (,) let optRemove = if firmSuperActRMSuperActive then id else const $ return 0
(nrRmSuper,nrRmSupers,nrRmSubs) <- runDB $ (,,)
<$> updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False] <$> updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
<*> if firmSuperActRMSuperActive /= Just True <*> optRemove (deleteWhereCount [UserSupervisorCompany ==. Just cid, UserSupervisorSupervisor <-. uids])
then return 0 <*> optRemove (deleteWhereCount [UserSupervisorCompany ==. Just cid, UserSupervisorUser <-. uids])
else E.deleteCount $ do let total = fromIntegral $ length uids
spr <- E.from $ E.table @UserSupervisor allok = bool Warning Success $ total == nrRmSuper
E.where_ $ spr E.^. UserSupervisorSupervisor `E.in_` E.vals uids addMessageI allok $ someMessages [MsgRemoveSupervisors nrRmSuper, MsgFirmRemoveSupervision nrRmSupers nrRmSubs]
E.&&. E.exists (do
usr <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
)
addMessageI Info $ MsgRemoveSupervisors nrRmSuper nrRmActual
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
(FirmSuperActSwitchSuperData{..}, Set.toList -> uids) -> do (FirmSuperActSwitchSuperData{..}, Set.toList -> uids) -> do
let (fltrSpr, changes) = case (firmSuperActSwitchSuper, firmSuperActSwitchReroute) of let (fltrSpr, changes) = case (firmSuperActSwitchSuper, firmSuperActSwitchReroute) of

2
src/Handler/Qualification.hs
View File

@ -543,7 +543,7 @@ postQualificationR sid qsh = do
Ex.groupBy (qblock Ex.^. QualificationUserBlockReason) Ex.groupBy (qblock Ex.^. QualificationUserBlockReason)
let countRows' :: Ex.SqlExpr (Ex.Value Int64) = Ex.countRows let countRows' :: Ex.SqlExpr (Ex.Value Int64) = Ex.countRows
Ex.orderBy [Ex.desc countRows'] Ex.orderBy [Ex.desc countRows']
Ex.limit 7 Ex.limit 9
pure (qblock Ex.^. QualificationUserBlockReason) pure (qblock Ex.^. QualificationUserBlockReason)
mkOption :: Ex.Value Text -> Option Text mkOption :: Ex.Value Text -> Option Text
mkOption (Ex.unValue -> t) = Option{ optionDisplay = t, optionInternalValue = t, optionExternalValue = toPathPiece t } mkOption (Ex.unValue -> t) = Option{ optionDisplay = t, optionInternalValue = t, optionExternalValue = toPathPiece t }

9
src/Handler/Users.hs
View File

@ -191,18 +191,19 @@ postUsersR = do
fmap (setOf $ folded . _Value . _Just) . Ex.select . Ex.distinct $ do fmap (setOf $ folded . _Value . _Just) . Ex.select . Ex.distinct $ do
usrc <- Ex.from $ Ex.table @UserSupervisor usrc <- Ex.from $ Ex.table @UserSupervisor
E.where_ $ E.isJust (usrc E.^. UserSupervisorReason) E.where_ $ E.isJust (usrc E.^. UserSupervisorReason)
Ex.limit 9
return $ usrc E.^. UserSupervisorReason return $ usrc E.^. UserSupervisorReason
acts :: Map UserAction (AForm Handler UserActionData) acts :: Map UserAction (AForm Handler UserActionData)
acts = mconcat acts = mconcat
[ singletonMap UserLdapSync $ pure UserLdapSyncData [ singletonMap UserLdapSync $ pure UserLdapSyncData
, singletonMap UserAvsSync $ pure UserAvsSyncData , singletonMap UserAvsSync $ pure UserAvsSyncData
, singletonMap UserAddSupervisor $ UserAddSupervisorData , singletonMap UserAddSupervisor $ UserAddSupervisorData
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True) <*> apopt boolField' (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
<*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing <*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
, singletonMap UserSetSupervisor $ UserSetSupervisorData , singletonMap UserSetSupervisor $ UserSetSupervisorData
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True) <*> apopt boolField' (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
<*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing <*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
, singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
, singletonMap UserRemoveSubordinates $ pure UserRemoveSubordinatesData , singletonMap UserRemoveSubordinates $ pure UserRemoveSubordinatesData

11
src/Handler/Utils/Company.hs
View File

@ -222,7 +222,8 @@ defaultSupervisorReasonFilter :: [Filter UserSupervisor]
defaultSupervisorReasonFilter = defaultSupervisorReasonFilter =
[UserSupervisorReason ==. Nothing] [UserSupervisorReason ==. Nothing]
||. [UserSupervisorReason ==. Just (tshow SupervisorReasonCompanyDefault)] ||. [UserSupervisorReason ==. Just (tshow SupervisorReasonCompanyDefault)]
-- ||. [UserSupervisorReason <-. [Just $ tshow r | r <- [SupervisorReasonCompanyDefault, SupervisorReasonAvsSuperior]]] ||. [UserSupervisorReason ==. Just (tshow SupervisorReasonAvsSuperior )]
-- ||. [UserSupervisorReason <-. Nothing : [Just $ tshow r | r <- [SupervisorReasonCompanyDefault, SupervisorReasonAvsSuperior]]] -- Does <-. work with Nothing?
-- | remove supervisors for given users; maybe restricted to those linked to given companies or supervisors -- | remove supervisors for given users; maybe restricted to those linked to given companies or supervisors
deleteDefaultSupervisorsForUsers :: [CompanyId] -> [UserId] -> NonEmpty UserId -> DB Int64 deleteDefaultSupervisorsForUsers :: [CompanyId] -> [UserId] -> NonEmpty UserId -> DB Int64
@ -232,14 +233,6 @@ deleteDefaultSupervisorsForUsers cids sprs usrs =
$ bcons (notNull sprs) (UserSupervisorSupervisor <-. sprs) $ bcons (notNull sprs) (UserSupervisorSupervisor <-. sprs)
$ (UserSupervisorUser <-. toList usrs) : defaultSupervisorReasonFilter $ (UserSupervisorUser <-. toList usrs) : defaultSupervisorReasonFilter
-- | deletes user company association and all company related supervision
-- WARNING: does not check for admin problems!
deleteCompanyUser :: CompanyId -> [UserId] -> DB (Int64, Int64, Int64)
deleteCompanyUser cid uids = (,,)
<$> deleteWhereCount [UserCompanyCompany ==. cid, UserCompanyUser <-. uids]
<*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorSupervisor <-. uids) : defaultSupervisorReasonFilter)
<*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorUser <-. uids) : defaultSupervisorReasonFilter)
-- | retrieve maximum company user priority fo a user -- | retrieve maximum company user priority fo a user
getCompanyUserMaxPrio :: UserId -> DB Int getCompanyUserMaxPrio :: UserId -> DB Int
getCompanyUserMaxPrio uid = do getCompanyUserMaxPrio uid = do

3
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -146,8 +146,7 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel
, avsLicenceSynchMaxChanges = maxChanges , avsLicenceSynchMaxChanges = maxChanges
} <- getsYesod $ view _appAvsLicenceSynchConf } <- getsYesod $ view _appAvsLicenceSynchConf
let -- TODO: enable a cron job by setting let procLic :: AvsLicence -> Bool -> Set AvsPersonId -> Handler ()
procLic :: AvsLicence -> Bool -> Set AvsPersonId -> Handler ()
procLic aLic up apids procLic aLic up apids
| n <- Set.size apids, n > 0 = | n <- Set.size apids, n > 0 =
let subtype = Text.cons (bool '↧' '↥' up) $ Text.singleton $ licence2char aLic let subtype = Text.cons (bool '↧' '↥' up) $ Text.singleton $ licence2char aLic

13
templates/i18n/firm-supervisors/de-de-formal.hamlet
View File

@ -5,10 +5,15 @@ $#
$# SPDX-License-Identifier: AGPL-3.0-or-later $# SPDX-License-Identifier: AGPL-3.0-or-later
<section> <section>
Bitte beachten, dass Ansprechpartner-Beziehung unabhängig von Firmenzugehörigkeit zwischen Einzelpersonen bestehen. <p>
Daraus folgt zum Beispiel, dass wenn <em>x</em> ein Standard-Ansprechpartner für Firma <em>a</em> ist Bitte beachten: Ansprechpartner-Beziehung bestehen unabhängig von Firmenzugehörigkeit zwischen Einzelpersonen! #
und wenn <em>y</em> sowohl Firma <em>a</em> als auch <em>b</em> angehört,
dass dann <em>x</em> als firmenfremd in der Liste der Ansprechpartner von Firma <em>b</em> angezeigt wird. <p>
Daraus folgt zum Beispiel, dass wenn <em>x</em> ein Standard-Ansprechpartner für Firma <em>a</em> ist #
und wenn <em>y</em> sowohl Firma <em>a</em> als auch <em>b</em> angehört, #
dass <em>x</em> als firmenfremd in der Liste der Ansprechpartner von Firma <em>b</em> angezeigt wird. #
Dies kann hier mit der Aktion "Firmenansprechpartner entfernen" nicht geändert werden, #
da die Ansprechpartnerbeziehung ja über eine andere Firma weiter existiert.
^{firmContactInfo} ^{firmContactInfo}

9
templates/i18n/firm-supervisors/en-eu.hamlet
View File

@ -5,9 +5,12 @@ $#
$# SPDX-License-Identifier: AGPL-3.0-or-later $# SPDX-License-Identifier: AGPL-3.0-or-later
<section> <section>
Note that supervision is company independent. <p>
For example, if <em>x</em> is a regular supervisor for company <em>a</em> and <em>y</em> belongs to companies <em>a</em> and <em>b</em>, Note that supervisionship is company independent! #
then <em>x</em> will be listed as a foreign supervisor for company <em>b</em>. <p>
For example, if <em>x</em> is a regular supervisor for company <em>a</em> and <em>y</em> belongs to companies <em>a</em> and <em>b</em>, #
then <em>x</em> will be listed as a foreign supervisor for company <em>b</em>. #
This cannot be changed through action "Remove default supervisor" here, since the external supervisionship persists.
^{firmContactInfo} ^{firmContactInfo}