diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 71549a505..203bd9c17 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -30,6 +30,7 @@ QualificationScheduleRenewalTooltip: Wird eine Benachrichtigung versendet, falls QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus QualificationUserNone: Für diese Person sind keine Qualifikationen registriert. QualificationBlockReason: Entzugsbegründung +QualificationBlockNotify: Benachrichtigung verschicken QualificationExpired: Ungültig seit LmsUser: Inhaber LmsURL: Link E‑Learning diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 674a34804..3c2037be0 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -30,6 +30,7 @@ QualificationScheduleRenewalTooltip: Will there be a notification, if this quali QualificationUserNoRenewal: Expires without further notification QualificationUserNone: No registered qualifications for this person. QualificationBlockReason: Reason for revoking +QualificationBlockNotify: Send notification QualificationExpired: Expired on LmsUser: Licensee LmsURL: Link E-learning diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 6d5952645..62ac59f13 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -352,6 +352,7 @@ data LicenceTableActionData = LicenceTableChangeAvsData | LicenceTableRevokeFDriveData { licenceTableChangeFDriveQId :: QualificationId , licenceTableChangeFDriveReason :: Text + , licenceTableChangeFDriveNotify :: Bool } | LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId @@ -444,7 +445,7 @@ getProblemAvsSynchR = do then return (-1) else do uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] [] - qualificationUserBlocking licenceTableChangeFDriveQId uids $ + qualificationUserBlocking licenceTableChangeFDriveQId uids licenceTableChangeFDriveNotify $ Just $ QualificationBlocked { qualificationBlockedDay = nowaday , qualificationBlockedReason = licenceTableChangeFDriveReason @@ -604,6 +605,8 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do then singletonMap LicenceTableRevokeFDrive $ LicenceTableRevokeFDriveData <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid <*> apreq textField (fslI MsgQualificationBlockReason) Nothing + <*> apreq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False) + else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid <*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?! diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 52e3f43ee..386bc4bf9 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -269,7 +269,7 @@ data QualificationTableActionData = QualificationActExpireData | QualificationActUnexpireData | QualificationActBlockSupervisorData - | QualificationActBlockData { qualTableActBlockReason :: Text } + | QualificationActBlockData { qualTableActBlockReason :: Text, qualTableActNotify :: Bool } | QualificationActUnblockData | QualificationActRenewData | QualificationActGrantData { qualTableActGrantUntil :: Day } @@ -489,6 +489,7 @@ postQualificationR sid qsh = do [ singletonMap QualificationActUnblock $ pure QualificationActUnblockData -- Admin-only actions , singletonMap QualificationActBlock $ QualificationActBlockData <$> apreq textField (fslI MsgQualificationBlockReason) Nothing + <*> apreq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False) , singletonMap QualificationActRenew $ pure QualificationActRenewData , singletonMap QualificationActGrant (QualificationActGrantData <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry) @@ -556,11 +557,14 @@ postQualificationR sid qsh = do , qualificationBlockedReason = qualTableActBlockReason } _ -> error "Handle.Qualification.isBlockAct returned non-block action" + notify = case action of + QualificationActBlockData{qualTableActNotify} -> qualTableActNotify + _ -> False oks <- runDB $ do deleteWhere [UserSupervisorUser <-. selUserIds] deleteWhere [UserCompanyUser <-. selUserIds] - qualificationUserBlocking qid selUserIds qubr + qualificationUserBlocking qid selUserIds notify qubr let nrq = length selectedUsers warnLevel = if | oks < 0 -> Error diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 6964073c5..e0f55bf6c 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -119,9 +119,10 @@ qualificationUserBlocking :: , MonadHandler m , MonadCatch m , Num n - ) => QualificationId -> [UserId] -> Maybe QualificationBlocked -> ReaderT (YesodPersistBackend (HandlerSite m)) m n + ) => QualificationId -> [UserId] -> Bool -> Maybe QualificationBlocked -> ReaderT (YesodPersistBackend (HandlerSite m)) m n -qualificationUserBlocking qid uids qb = do +qualificationUserBlocking qid uids notify qb = do + now <- liftIO getCurrentTime oks <- updateWhereCount -- prevents storage of transactionQualificatioUser ( [ QualificationUserBlockedDue !=. Nothing | isNothing qb -- only unblock blocked qualification; allow overwrite for existing blocks ] ++ @@ -129,8 +130,11 @@ qualificationUserBlocking qid uids qb = do , QualificationUserUser <-. uids ] ) - [ QualificationUserBlockedDue =. qb - ] + (guardMonoid (not notify) + [ QualificationUserLastNotified =. now + ] ++ + [ QualificationUserBlockedDue =. qb + ]) forM_ uids $ \uid -> do audit TransactionQualificationUserBlocking { -- transactionQualificationUser = quid diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index f78fdebd5..2e2a95a51 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -315,7 +315,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act , transactionReceived = lReceived } update luid [LmsUserStatus =. newStatus] - void $ qualificationUserBlocking qid [lmsUserUser luser] $ Just $ mkQualificationBlocked QualificationBlockFailedELearning lmsMsgDay + void $ qualificationUserBlocking qid [lmsUserUser luser] True $ Just $ mkQualificationBlocked QualificationBlockFailedELearning lmsMsgDay -- DEACTIVATED FOR NOW; UPON REACTIVATION: DELAY Sending to check for unblocking a few hours later! -- queueDBJob JobSendNotification -- { jRecipient = lmsUserUser luser