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

chore(users): multiple name filter and remove subordinates

Browse Source
This commit is contained in:
Steffen Jost 2024-06-20 12:58:34 +02:00
parent e5cbd096ce
commit 34199a37fd
7 changed files with 39 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -94,6 +94,7 @@ UserHijack: Sitzung übernehmen
UserAddSupervisor: Ansprechpartner hinzufügen
UserSetSupervisor: Ansprechpartner ersetzen
UserRemoveSupervisor: Alle Ansprechpartner entfernen
UserRemoveSubordinates: Alle Ansprechpartnerbeziehungen zu Untergebenen beenden
UserIsSupervisor: Ist Ansprechpartner
UserAvsSwitchCompany: Als Primärfirma verwenden
UserAvsCompanySwitched c@CompanyShorthand: Primärfirma gewechselt zu #{tshow c}
@ -106,4 +107,5 @@ 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 _{MsgUsersChangeSupervisorsSuccess usr spr} #{tshow bad} Ansprechpartner #{pluralDE bad "wurde" "wurden"} nicht gefunden!
UsersRemoveSupervisors usr@Int: Alle Ansprechpartner für #{tshow usr} Benutzer gelöscht.
UsersRemoveSubordinates usr@Int: Alle Ansprechpartnerbeziehungen für #{tshow usr} #{pluralDE usr "ehemaligen" "ehemalige"} Ansprechpartner gelöscht.
SupervisorReason: Begründung

2
messages/uniworx/categories/user/en-eu.msg
View File

@ -94,6 +94,7 @@ UserHijack: Hijack session
UserAddSupervisor: Add supervisor
UserSetSupervisor: Replace supervisors
UserRemoveSupervisor: Set to unsupervised
UserRemoveSubordinates: Remove all subordinates
UserIsSupervisor: Is supervisor
UserAvsSwitchCompany: Use as primary company
UserAvsCompanySwitched c: Primary company switched to #{tshow c}
@ -106,4 +107,5 @@ Name: Name
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"}.
UsersRemoveSubordinates usr: Removed all subordinates for #{pluralENsN usr "previous supervisor"}.
SupervisorReason: Reason

1
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -106,6 +106,7 @@ ActJobDelete: Job entfernen
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt
TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss.
TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol.
TableFilterCommaPlusShort: Unterstützt mehrere Kriterien mit Komma-Plus, siehe oben.
TableFilterCommaName: Mehrere Namen mit Komma trennen.
TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.
TableUserEdit: Benutzer bearbeiten

1
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -106,6 +106,7 @@ ActJobDelete: Delete job
TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted
TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled.
TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol.
TableFilterCommaPlusShort: Support multiple criteria with comma/plus, see above.
TableFilterCommaName: Separate names by comma.
TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact.
TableUserEdit: Edit user

6
src/Handler/PrintCenter.hs
View File

@ -245,11 +245,11 @@ mkPJTable = do
--, prismAForm (singletonFilter "created" . maybePrism _PathPiece) mPrev ((,) <$> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated)
-- <*> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated)
-- )
, prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
, prismAForm (singletonFilter "sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender & setTooltip MsgTableFilterCommaPlus)
, prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlusShort)
, prismAForm (singletonFilter "sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender & setTooltip MsgTableFilterCommaPlusShort)
, prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)
, prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification)
, prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser & setTooltip MsgTableFilterCommaPlus)
, prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser & setTooltip MsgTableFilterCommaPlusShort)
, prismAForm (singletonFilter "apcid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobApcAcknowledge & setTooltip MsgTableFilterComma)
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
]

50
src/Handler/Users.hs
View File

@ -62,7 +62,7 @@ hijackUserForm = \csrf -> do
-- instance HasUser (DBRow (Entity USer)) where
-- hasUser = _entityVal
data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor
data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor | UserRemoveSubordinates
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
deriving anyclass (Universe, Finite)
@ -75,6 +75,7 @@ data UserActionData = UserAvsSyncData
| UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
| UserSetSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
| UserRemoveSupervisorData
| UserRemoveSubordinatesData
deriving (Eq, Ord, Read, Show, Generic)
@ -198,6 +199,7 @@ postUsersR = do
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
<*> aopt textField (fslI MsgSupervisorReason) Nothing
, singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
, singletonMap UserRemoveSubordinates $ pure UserRemoveSubordinatesData
]
over _1 postprocess <$> dbTable psValidator DBTable
@ -258,20 +260,21 @@ postUsersR = do
)
]
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates
[ ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) ->
if Set.null criteria then E.true else -- TODO: why is this condition not needed?
-- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
E.any (\c -> user E.^. UserDisplayName `E.hasInfix` E.val c) criteria
)
, ( "user-ident", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> E.castString (user E.^. UserIdent) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
)
, ( "user-email", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
)
[ fltrUserNameEmail id
-- , ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) ->
-- if Set.null criteria then E.true else -- TODO: why is this condition not needed?
-- -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
-- E.any (\c -> user E.^. UserDisplayName `E.hasInfix` E.val c) criteria
-- )
-- , ( "user-ident", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
-- Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-- Just needle -> E.castString (user E.^. UserIdent) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
-- )
-- , ( "user-email", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
-- Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-- Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
-- E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
-- )
, ( "personal-number" , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserCompanyPersonalNumber))
, ( "matriculation" , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserMatrikelnummer)) -- allows partial matches
, ( "company-department", FilterColumn $ \user (criteria :: Set.Set Text) -> if -- exact filter on table UserAvs
@ -326,12 +329,13 @@ postUsersR = do
)
]
, dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName)
, prismAForm (singletonFilter "user-ident") mPrev $ aopt textField (fslI MsgAdminUserIdent)
, prismAForm (singletonFilter "user-email") mPrev $ aopt textField (fslI MsgAdminUserEmail)
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber & setTooltip MsgTableFilterCommaPlus)
, prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr & setTooltip MsgTableFilterCommaPlus) -- contains filter on UserMatrikelnummer
-- , prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo & setTooltip MsgTableFilterCommaPlus) -- exact filter on table UserAvs
[ fltrUserNameEmailHdrUI MsgName mPrev
-- , prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName)
-- , prismAForm (singletonFilter "user-ident") mPrev $ aopt textField (fslI MsgAdminUserIdent)
-- , prismAForm (singletonFilter "user-email") mPrev $ aopt textField (fslI MsgAdminUserEmail)
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber & setTooltip MsgTableFilterCommaPlusShort)
, prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr & setTooltip MsgTableFilterCommaPlusShort) -- contains filter on UserMatrikelnummer
-- , prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo & setTooltip MsgTableFilterCommaPlusShort) -- exact filter on table UserAvs
, prismAForm (singletonFilter "company-department") mPrev $ aopt textField (fslI MsgCompanyDepartment)
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
, prismAForm (singletonFilter "user-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
@ -379,6 +383,10 @@ postUsersR = do
runDB $ deleteWhere [UserSupervisorUser <-. Set.toList userSet]
addMessageI Success $ MsgUsersRemoveSupervisors $ Set.size userSet
redirectKeepGetParams UsersR
(UserRemoveSubordinatesData, userSet) -> do
runDB $ deleteWhere [UserSupervisorSupervisor <-. Set.toList userSet]
addMessageI Success $ MsgUsersRemoveSubordinates $ Set.size userSet
redirectKeepGetParams UsersR
(act, usersSet)
| isActionSupervisor act -> do
avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser $ getActionSupervisors act

1
src/Utils/Print/RenewQualification.hs
View File

@ -126,6 +126,7 @@ instance MDLetter LetterRenewQualification where
[ toMeta "practical" True
] <>
[ toMeta "lang" lang
, toMeta "shwow-lang" $ tshow lang
, toMeta "login" lmsIdent
, toMeta "pin" lmsPin
, toMeta "examinee" qualHolderDN