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

chore(lms): complete lms renewal notification and adjust db filling

Browse Source
This commit is contained in:
Steffen Jost 2022-04-26 17:38:03 +02:00
parent 166323cc86
commit c7c0cf89ab
6 changed files with 55 additions and 19 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

@ -44,3 +44,4 @@ LmsDirectUpload: Direkter Upload für automatisierte Systeme
LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab
MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Learning Kurs erneuern.

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

@ -44,3 +44,4 @@ LmsDirectUpload: Direct upload for automated Systems
LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically due to refresh-within time period not being set.
MailSubjectQualificationRenewal qname@Text: Your qualification #{qname} must be renewed shortly
MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon
MailLmsRenewalBody: You will soon need to renew this qualficiation by completing an e-learning course.

4
src/Handler/Utils/Table/Pagination.hs
View File

@ -1066,9 +1066,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
<|> piInput
psShortcircuit <- (== Just dbtIdent') <$> lookupCustomHeader HeaderDBTableShortcircuit
lch <- lookupCustomHeader HeaderDBTableShortcircuit
$logErrorS "DBShortcircuit" $ fromMaybe mempty lch <> " and also " <> tshow psShortcircuit
let
-- adjustPI = over _piSorting $ guardOnM doSorting -- probably not neccessary; not displaying the links should be enough for now
((errs, PaginationSettings{..}), paginationInput@PaginationInput{..})

7
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -37,7 +37,7 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use
dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
dispatchNotificationQualificationRenewal nQualification jRecipient = userMailT jRecipient $ do
(User{}, Qualification{..}, Entity _ QualificationUser{}) <- liftHandler . runDB $ (,,)
(User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
<$> getJust jRecipient
<*> getJust nQualification
<*> getJustBy (UniqueQualificationUser nQualification jRecipient)
@ -46,9 +46,8 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = userMailT j
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectQualificationRenewal qname
_editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
--addHtmlMarkdownAlternatives $(i18nHamletFile "qualification/renewal")
-- TODO: this is just a dummy to continue while i18nHamletFile usage is unclear
error "TODO: QualificationRenewal notification no yet implemented"
-- addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")

37
templates/mail/qualificationRenewal.hamlet Normal file
View File

@ -0,0 +1,37 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectQualificationRenewal qname}
<p>
_{SomeMessage MsgMailLmsRenewalBody}
<br />
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
<p>
Name:
#{nameHtml userDisplayName userSurname}
<p>
Qualifikation:
#{qname}
<p>
Gültig bis:
#{show qualificationUserValidUntil}
<p>
Zuerst erhalten:
#{show qualificationUserFirstHeld}
^{ihamletSomeMessage editNotifications}

24
test/Database/Fill.hs
View File

@ -461,9 +461,9 @@ fillDb = do
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just $ 5 * 12) (Just $ CalendarDiffDays 0 60) True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just $ 5 * 12) (Just $ CalendarDiffDays 2 3) False
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just $ 5 * 12) Nothing True
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3) False
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) -- TODO: better dates!
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20)
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8)
@ -475,15 +475,15 @@ fillDb = do
void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7)
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now
void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False Nothing now Nothing Nothing
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False (Just $ LmsSuccess $ utctDay now) now (Just now) Nothing
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True (Just $ LmsBlocked $ utctDay now) now (Just now) Nothing
-- void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
-- void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
-- void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now
-- void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
-- void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
-- void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
-- void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False Nothing now Nothing Nothing
-- void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False (Just $ LmsSuccess $ utctDay now) now (Just now) Nothing
-- void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True (Just $ LmsBlocked $ utctDay now) now (Just now) Nothing
let
sdBsc = StudyDegreeKey' 82