chore(letter): option to avoid sending a notification upon blocking

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

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

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?!

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

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

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