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

fix(qualifications): fix #78 block/unblock no longer deletes company association

Browse Source
This commit is contained in:
Steffen Jost 2023-05-26 08:34:02 +00:00
parent f64b985d35
commit 3cb66c6211
3 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -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

1
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -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

13
src/Handler/Qualification.hs
View File

@ -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