chore(lms): no longer abort jobs with error

src/Jobs/Handler/LMS.hs

@@ -150,10 +150,8 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
     -- act :: YesodJobDB UniWorX ()
     act = hoist lift $ do
       quali <- getJust qid
-      now <- liftIO getCurrentTime
+      whenIsJust (qualificationValidDuration quali) $ \renewalMonths -> do 
-      let nowadayP1 = succ $ utctDay now -- add one day to account for time synch problems
+        -- otherwise there is nothing to do: we cannot renew s qualification  without a specified validDuration        
-          renewalMonths :: Word = fromMaybe (error ("Cannot renew qualification " <> citext2string (qualificationShorthand quali) <> " without specified validDuration!"))
-                                            (qualificationValidDuration quali)
         -- result :: [(Entity QualificationUser, Entity LmsUser, Entity LmsResult)]
         results <- E.select $ do
           (quser E.:& luser E.:& lresult) <- E.from $
@@ -171,9 +169,11 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
             E.&&. E.isNothing (luser E.^. LmsUserStatus)  -- do not process learners already having a result
             E.&&. E.isNothing (luser E.^. LmsUserEnded)   -- do not process closed learners
           return (quser, luser, lresult)
+        now <- liftIO getCurrentTime                  
         forM_ results $ \(Entity quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do
           -- three separate DB operations per result is not so nice. All within one transaction though.
-        let lmsUserStartedDay = utctDay lmsUserStarted
+          let nowadayP1 = succ $ utctDay now -- add one day to account for time synch problems        
+              lmsUserStartedDay = utctDay lmsUserStarted
               saneDate    = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil nowadayP1)
                             && qualificationUserLastRefresh <= lmsUserStartedDay
               newStatus   = LmsSuccess lmsResultSuccess

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -24,6 +24,8 @@ import Text.Hamlet
 -- import qualified Database.Esqueleto.Utils as E
 
 
+-- TODO: refactor! Do not call error in Jobs, as this results in locked jobs. Abort graceful!
+
 dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
 dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
   (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
@@ -83,11 +85,12 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
                   , toMeta "url-text"       lmsUrl
                   , toMeta "url"            lmsLogin
                   ]
-      emailRenewal attachment = do         
+      emailRenewal attachment 
-        when (Text.null (CI.original userEmail)) $ do 
+        | Text.null (CI.original userEmail) = do          -- if neither email nor postal address is known, we must abort! 
             let msg = "Notify " <> tshow encRecipient <> " failed: no email nor address for user known!"
             $logErrorS "LMS" msg 
-          error $ unpack msg                            -- if neither email nor postal address is known, we must abort! 
+            return False
+        | otherwise = do
             userMailT jRecipient $ do 
               replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
               setSubjectI $ MsgMailSubjectQualificationRenewal qname
@@ -98,18 +101,21 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
                               } :: PureFile)
               editNotifications <- mkEditNotifications jRecipient
               addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
+            return True
 
-  pdfRenewal pdfMeta >>= \case
+  notifyOk <- pdfRenewal pdfMeta >>= \case
     Right pdf | userPrefersLetter recipient ->          -- userPrefersLetter is false if both userEmail and userPostAddress are null
       let printSender  = Nothing 
       in runDB (sendLetter printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification)) >>= \case        
         Left err -> do
           let msg = "Notify " <> tshow encRecipient <> ": PDF printing to send letter failed with error " <> cropText err 
           $logErrorS "LMS" msg
-          error $ unpack msg
+          return False
         Right (msg,_) 
-          | null msg  -> return ()
+          | null msg  -> return True
-          | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg
+          | otherwise -> do 
+              $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg
+              return True
 
     Right pdf -> do
       attch <- case userPinPassword of 
@@ -127,6 +133,5 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
       $logErrorS "LMS" msg
       emailRenewal Nothing
         
-  -- if we reach the end, mark the user as notified.  TODO: Maybe defer this until the print job is marked as sent?
+  when notifyOk $ runDB $ update luid [ LmsUserNotified =. Just now]
-  runDB $ update luid [ LmsUserNotified =. Just now]