diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 210621981..1c68157b7 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -62,10 +62,38 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act $logInfoS "LMS" $ "Notifying about exipiring qualification " <> qshort now <- liftIO getCurrentTime case qualificationRefreshWithin quali of - Nothing -> return () -- no automatic scheduling for this qid + Nothing -> return () -- TODO: no renewal period, no reminders currenty (Just renewalPeriod) -> do let now_day = utctDay now - renewalDate = addGregorianDurationClip renewalPeriod now_day + renewalDate = addGregorianDurationClip renewalPeriod now_day + sendReminders remindPeriod = do + let remindDate = addGregorianDurationClip remindPeriod now_day + reminders <- E.select $ do -- TODO: refactor to remove some redundancies with later query + (luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser + `E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification + E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser + ) + E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid + E.&&. quser E.^. QualificationUserScheduleRenewal + E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day + E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate + E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue) + E.&&. E.isNothing (luser E.^. LmsUserEnded) + E.&&. E.isNothing (luser E.^. LmsUserStatus) + E.&&. E.isJust (luser E.^. LmsUserNotified) + -- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead + return (luser, quser E.^. QualificationUserValidUntil) + forM_ reminders $ \case + (Entity _ (LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}), E.Value quValidUntil) + | addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil -> + queueDBJob JobSendNotification + { jRecipient = luser + , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True } + } + _ -> return () + -- send second reminders first, before enqueing even more + ifMaybeM (qualificationRefreshReminder quali) () sendReminders + renewalUsers <- E.select $ do quser <- E.from $ E.table @QualificationUser E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid @@ -277,37 +305,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act where act :: YesodJobDB UniWorX () act = do - now <- liftIO getCurrentTime - -- send reminders first -- TODO: move to dispatchJobLmsEnqueueUser - let sendReminders remindPeriod = do - let now_day = utctDay now - remindDate = addGregorianDurationClip remindPeriod now_day - reminders <- E.select $ do - (luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser - `E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification - E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser - ) - E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid - E.&&. quser E.^. QualificationUserScheduleRenewal - E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day - E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate - E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue) - E.&&. E.isNothing (luser E.^. LmsUserEnded) - E.&&. E.isNothing (luser E.^. LmsUserStatus) - E.&&. E.isJust (luser E.^. LmsUserNotified) - -- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead - return (luser, quser E.^. QualificationUserValidUntil) - forM_ reminders $ \case - (Entity _ (LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}), E.Value quValidUntil) - | addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil -> - queueDBJob JobSendNotification - { jRecipient = luser - , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True } - } - _ -> return () - maybeM (return ()) sendReminders ((>>= view _qualificationRefreshReminder) <$> get qid) - -- now process actual results - + now <- liftIO getCurrentTime -- result :: [(Entity LmsUser, Entity LmsUserlist)] results <- E.select $ do (luser :& lulist) <- E.from $ diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index a9307d80d..7d24d8ff0 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -67,6 +67,9 @@ instance MDLetter LetterRenewQualificationF where , toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text) , toMeta "en-opening" ("Dear Sir or Madam,"::Text) ] <> + guardMonoid isReminder + [ toMeta "reminder" ("reminder"::Text) + ] <> [ toMeta "lang" lang , toMeta "login" lmsIdent , toMeta "pin" lmsPin @@ -75,11 +78,12 @@ instance MDLetter LetterRenewQualificationF where , mbMeta "validduration" (show <$> qualDuration) , toMeta "url-text" lmsUrl , toMeta "url" lmsUrlLogin + ] getPJId LetterRenewQualificationF{..} = PrintJobIdentification - { pjiName = "Renewal" + { pjiName = bool "Renewal Reminder" "Renewal" isReminder , pjiApcAcknowledge = "lms-" <> getLmsIdent lmsLogin , pjiRecipient = Nothing -- to be filled later , pjiSender = Nothing diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index be6d80117..6ccf3e228 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -54,13 +54,19 @@ $endfor$ $if(is-de)$ -die Gültigkeit +$if(reminder)$ + dies ist die letzte **Erinnerung**: bis $date$ wurde das E-Learning noch nicht abgeschlossen. + Bitte schnellstmöglich durchführen, da ansonsten die Qualifikation + nach dem Ablauftag automatisch entzogen wird! +$else$ + die Gültigkeit $if(supervisor)$ des Vorfeldführerscheins von $examinee$ $else$ Ihres Vorfeldführerscheins $endif$ läuft bald ab. +$endif$ Durch die erfolgreiche Teilnahme an einem E-Learning kann die Gültigkeit $if(validduration)$ um $validduration$ Monate @@ -96,12 +102,17 @@ Bei Fragen können Sie sich gerne an das Team der Fahrerausbildung wenden. $else$ +$if(reminder)$ + this is a last **reminder**: as of $date$, the below detailed e-learning has not yet been completed. + The qualification will expire automatically, if the e-learning is not concluded! +$else$ $if(supervisor)$ the apron diving license of $examinee$ $else$ your apron diving license $endif$ -is about to expire soon. + is about to expire soon. +$endif$ The validity will be extended $if(validduration)$ by $validduration$ months