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

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

View File

@ -32,6 +32,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert. QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
QualificationBlockReason: Entzugsbegründung QualificationBlockReason: Entzugsbegründung
QualificationBlockNotify: Benachrichtigung verschicken QualificationBlockNotify: Benachrichtigung verschicken
QualificationBlockRemoveSupervisor: Alle Ansprechpartner löschen
QualificationExpired: Ungültig seit QualificationExpired: Ungültig seit
LmsUser: Inhaber LmsUser: Inhaber
LmsURL: Link ELearning LmsURL: Link ELearning

View File

@ -32,6 +32,7 @@ QualificationUserNoRenewal: Expires without further notification
QualificationUserNone: No registered qualifications for this person. QualificationUserNone: No registered qualifications for this person.
QualificationBlockReason: Reason for revoking QualificationBlockReason: Reason for revoking
QualificationBlockNotify: Send notification QualificationBlockNotify: Send notification
QualificationBlockRemoveSupervisor: Remove all supervisors
QualificationExpired: Expired on QualificationExpired: Expired on
LmsUser: Licensee LmsUser: Licensee
LmsURL: Link E-learning LmsURL: Link E-learning

View File

@ -269,7 +269,7 @@ data QualificationTableActionData
= QualificationActExpireData = QualificationActExpireData
| QualificationActUnexpireData | QualificationActUnexpireData
| QualificationActBlockSupervisorData | QualificationActBlockSupervisorData
| QualificationActBlockData { qualTableActBlockReason :: Text, qualTableActNotify :: Bool } | QualificationActBlockData { qualTableActBlockReason :: Text, qualTableActNotify :: Bool, qualTableActRemoveSupervisors :: Bool }
| QualificationActUnblockData | QualificationActUnblockData
| QualificationActRenewData | QualificationActRenewData
| QualificationActGrantData { qualTableActGrantUntil :: Day } | QualificationActGrantData { qualTableActGrantUntil :: Day }
@ -286,6 +286,11 @@ isBlockAct QualificationActBlockData{} = True
isBlockAct QualificationActUnblockData = True isBlockAct QualificationActUnblockData = True
isBlockAct _ = False isBlockAct _ = False
blockActRemoveSupervisors :: QualificationTableActionData -> Bool
blockActRemoveSupervisors QualificationActBlockSupervisorData = True
blockActRemoveSupervisors QualificationActBlockData{qualTableActRemoveSupervisors=res} = res
blockActRemoveSupervisors _ = False
qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
, E.SqlExpr (Entity User) , E.SqlExpr (Entity User)
@ -491,7 +496,8 @@ postQualificationR sid qsh = do
[ singletonMap QualificationActUnblock $ pure QualificationActUnblockData -- Admin-only actions [ singletonMap QualificationActUnblock $ pure QualificationActUnblockData -- Admin-only actions
, singletonMap QualificationActBlock $ QualificationActBlockData , singletonMap QualificationActBlock $ QualificationActBlockData
<$> apreq textField (fslI MsgQualificationBlockReason) Nothing <$> 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 QualificationActRenew $ pure QualificationActRenewData
, singletonMap QualificationActGrant $ QualificationActGrantData , singletonMap QualificationActGrant $ QualificationActGrantData
<$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
@ -562,8 +568,7 @@ postQualificationR sid qsh = do
_ -> False _ -> False
oks <- runDB $ do oks <- runDB $ do
deleteWhere [UserSupervisorUser <-. selUserIds] when (blockActRemoveSupervisors action) $ deleteWhere [UserSupervisorUser <-. selUserIds]
deleteWhere [UserCompanyUser <-. selUserIds]
qualificationUserBlocking qid selUserIds notify qubr qualificationUserBlocking qid selUserIds notify qubr
let nrq = length selectedUsers let nrq = length selectedUsers
warnLevel = if warnLevel = if