fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(qualifications): fix #84 to show users about to be notified

Browse Source
This commit is contained in:
Steffen Jost 2023-06-15 10:44:59 +00:00
parent 54f902a83b
commit 78231b8dd1
4 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -64,6 +64,7 @@ LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stu
FilterLmsValid: Aktuell gültig FilterLmsValid: Aktuell gültig
FilterLmsRenewal: Erneuerung anstehend FilterLmsRenewal: Erneuerung anstehend
FilterLmsNotified: Benachrichtigt FilterLmsNotified: Benachrichtigt
FilterLmsNotificationDue: Benachrichtigung erforderlich
CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
CsvColumnLmsPin: Passwort E#{nonBreakableDash}Learning Zugang CsvColumnLmsPin: Passwort E#{nonBreakableDash}Learning Zugang
CsvColumnLmsResetPin: Wird das E-Learning Passwort bei der nächsten Synchronisation zurückgesetzt? CsvColumnLmsResetPin: Wird das E-Learning Passwort bei der nächsten Synchronisation zurückgesetzt?

1
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -64,6 +64,7 @@ LmsStatusDelay: Note that status changes may occassionaly require more than a ho
FilterLmsValid: Currently valid FilterLmsValid: Currently valid
FilterLmsRenewal: Renewal due FilterLmsRenewal: Renewal due
FilterLmsNotified: Notified FilterLmsNotified: Notified
FilterLmsNotificationDue: Notification due
CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user
CsvColumnLmsPin: Password e#{nonBreakableDash}learning access CsvColumnLmsPin: Password e#{nonBreakableDash}learning access
CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation? CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation?

11
src/Handler/Qualification.hs
View File

@ -395,6 +395,16 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
| otherwise -> E.true | otherwise -> E.true
) )
, single ("tobe-notified", FilterColumn $ \(queryQualUser -> quser) criterion ->
if | Just True <- getLast criterion ->
(( E.isNothing (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
) E.||. (
E.isJust (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
))
| otherwise -> E.true
)
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
@ -405,6 +415,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid) , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
, if isNothing mbRenewal then mempty , if isNothing mbRenewal then mempty
else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal) else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
, prismAForm (singletonFilter "tobe-notified" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsNotificationDue)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtCsvEncode = Just DBTCsvEncode dbtCsvEncode = Just DBTCsvEncode

10
src/Jobs/Handler/LMS.hs
View File

@ -170,7 +170,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue) E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
) E.||. ( ) E.||. (
E.isJust (quser E.^. QualificationUserBlockedDue) E.isJust (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day")) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
)) ))
pure (quser E.^. QualificationUserUser) pure (quser E.^. QualificationUserUser)
@ -255,8 +255,8 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
] ]
return Nothing return Nothing
else do else do
let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|] let errmsg = [st|LMS Result: success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|]
$logErrorS "LmsResult" errmsg $logErrorS "LMS" errmsg
return $ Just errmsg return $ Just errmsg
audit TransactionLmsSuccess -- always log success, since this is only transmitted once audit TransactionLmsSuccess -- always log success, since this is only transmitted once
@ -268,7 +268,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
, transactionReceived = lmsResultTimestamp , transactionReceived = lmsResultTimestamp
} }
delete lrid delete lrid
$logInfoS "LmsResult" [st|Processed #{tshow (length results)} LMS results|] $logInfoS "LMS" [st|Processed #{tshow (length results)} LMS results|]
-- processes received input and block qualifications, if applicable -- processes received input and block qualifications, if applicable
@ -327,4 +327,4 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
-- } -- }
delete lulid delete lulid
$logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|] $logInfoS "LMS" [st|Processed LMS Userlist with ${tshow (length results)} entries|]