Merge branch 'fradrive/newletter'
This commit is contained in:
commit
93196a6400
@ -126,6 +126,7 @@ AdminProblemSolved: Erledigt
|
||||
AdminProblemSolver: Bearbeitet von
|
||||
AdminProblemCreated: Erkannt
|
||||
AdminProblemInfo: Problembeschreibung
|
||||
AdminProblemInfoTooltip: Nur Teile der folgenden englische Begriffe sind derzeit möglich: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
|
||||
AdminProblemsSolved n@Int: #{pluralDEeN n "Admin Problem"} als erledigt markiert
|
||||
AdminProblemsReopened n@Int: #{pluralDEeN n "Admin Problem"} erneut eröffnet
|
||||
AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen
|
||||
|
||||
@ -126,6 +126,7 @@ AdminProblemSolved: Done
|
||||
AdminProblemSolver: Solved by
|
||||
AdminProblemCreated: Recognized
|
||||
AdminProblemInfo: Problem
|
||||
AdminProblemInfoTooltip: Only parts of the following keys currently work here: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
|
||||
AdminProblemsSolved n: #{pluralENsN n "admin problem"} marked as solved
|
||||
AdminProblemsReopened n: #{pluralENsN n "admin problem"} reopened
|
||||
AdminProblemNewCompany: New company from AVS; verify and add default supervisors
|
||||
|
||||
@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatis
|
||||
QualificationRefreshReminder: 2. Erinnerung
|
||||
QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
|
||||
QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
|
||||
QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
|
||||
QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
|
||||
QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.
|
||||
TableQualificationCountActive: Aktive
|
||||
@ -47,11 +48,12 @@ QualificationExpired: Ungültig seit
|
||||
LmsUser: Inhaber
|
||||
LmsURL: Link E‑Learning
|
||||
TableLmsEmail: E‑Mail
|
||||
TableLmsIdent: E-Learning Benutzer
|
||||
TableLmsIdent: E‑Learning Benutzer
|
||||
TableLmsElearning: E‑Learning
|
||||
TableLmsElearningRenews: Automatische Verlängerung
|
||||
TableLmsPin: E‑Learning Passwort
|
||||
TableLmsResetPin: E-Learning Passwort zurücksetzen?
|
||||
TableLmsDatePin: E-Learning Passwort erstellt
|
||||
TableLmsResetPin: E‑Learning Passwort zurücksetzen?
|
||||
TableLmsDatePin: E‑Learning Passwort erstellt
|
||||
TableLmsDate: Datum
|
||||
TableLmsDelete: Löschen?
|
||||
TableLmsStaff: Interner Mitarbeiter?
|
||||
@ -89,7 +91,8 @@ LmsReportInsert: Neues LMS Ereignis
|
||||
LmsReportUpdate: LMS Ereignis Aktualisierung
|
||||
LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel
|
||||
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
|
||||
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde!
|
||||
LmsErrorNoRenewElearning: Fehler: Erfoglreiches E‑Learning verlängert die Qualifikation nicht automatisch, da die Gültigkeitsdauer nicht festgelegt wurde!
|
||||
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
|
||||
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
||||
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
||||
|
||||
@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optional period before expiry to start e‑le
|
||||
QualificationRefreshReminder: 2. Reminder
|
||||
QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
|
||||
QualificationElearningStart: Is e‑learning automatically started?
|
||||
QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
|
||||
QualificationExpiryNotification: Invalidity notification?
|
||||
QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.
|
||||
TableQualificationCountActive: Active
|
||||
@ -50,6 +51,7 @@ TableLmsEmail: Email
|
||||
TableLmsIdent: E‑learning user
|
||||
TableLmsPin: E‑learning password
|
||||
TableLmsElearning: E‑learning
|
||||
TableLmsElearningRenews: Automatic renewal
|
||||
TableLmsResetPin: Reset E‑learning password?
|
||||
TableLmsDatePin: E‑learning password created
|
||||
TableLmsDate: Date
|
||||
@ -89,7 +91,8 @@ LmsReportInsert: New LMS event
|
||||
LmsReportUpdate: Update of LMS event
|
||||
LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key
|
||||
LmsDirectUpload: Direct upload for automated systems
|
||||
LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set.
|
||||
LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set!
|
||||
LmsErrorNoRenewElearning: Error: E‑learning will not automatically extend validity due to validity duration not being set!
|
||||
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
|
||||
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
|
||||
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
||||
|
||||
@ -13,7 +13,7 @@ Qualification
|
||||
refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip
|
||||
refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry
|
||||
elearningStart Bool -- automatically schedule e-refresher
|
||||
-- elearningOnly Bool -- successful E-learing automatically increases validity. NO!
|
||||
elearningRenews Bool default=true -- successful E-learing automatically increases validity automatically by validDuration
|
||||
expiryNotification Bool default=true -- should expiryNotification be generated for this qualification?
|
||||
avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
|
||||
sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
|
||||
|
||||
@ -261,6 +261,7 @@ derivePersistFieldJSON ''Transaction
|
||||
-- Datatype for raising admin awareness to certain problems
|
||||
-- Database stores generic Value in table ProblemLog, such that changes do not disturb old entries
|
||||
-- Note that there is no RenderMessage instance, instead see @Handler.Admin.adminProblemCell dealing with special cases instead
|
||||
-- Note: Adjust MsgAdminProblemInfoTooltip as well
|
||||
data AdminProblem
|
||||
= AdminProblemNewCompany -- new company was noticed, presumably without supervisors
|
||||
{ adminProblemCompany :: CompanyId
|
||||
|
||||
@ -339,10 +339,18 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
|
||||
, single ("solver", sortUserNameBareM querySolver)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
|
||||
[ single ("user" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryUser) (E.?. UserDisplayName))
|
||||
, single ("solver" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySolver) (E.?. UserDisplayName))
|
||||
, single ("problem" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo)))
|
||||
, single ("company" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "company").(E.^. ProblemLogInfo)))
|
||||
, single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
|
||||
[ prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemUser & setTooltip MsgTableFilterCommaPlus)
|
||||
, prismAForm (singletonFilter "solver" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemSolver & setTooltip MsgTableFilterCommaPlusShort)
|
||||
, prismAForm (singletonFilter "problem" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemInfo & setTooltip MsgAdminProblemInfoTooltip)
|
||||
, prismAForm (singletonFilter "company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableCompanyShort)
|
||||
, prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
|
||||
]
|
||||
acts :: Map ProblemTableAction (AForm Handler ProblemTableActionData)
|
||||
acts = mconcat
|
||||
|
||||
@ -229,7 +229,7 @@ postAdminTestR = do
|
||||
let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
|
||||
siteLayout locallyDefinedPageHeading $ do
|
||||
-- defaultLayout $ do
|
||||
setTitle "Uni2work Admin Testpage"
|
||||
setTitle "Uni2work Admin Testpage"
|
||||
|
||||
$(i18nWidgetFile "admin-test")
|
||||
|
||||
@ -332,7 +332,7 @@ postAdminTestR = do
|
||||
|
||||
getAdminTestPdfR :: Handler TypedContent
|
||||
getAdminTestPdfR = do
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
qual <- fromMaybeM
|
||||
(addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
|
||||
(runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
|
||||
@ -351,8 +351,9 @@ getAdminTestPdfR = do
|
||||
, qualShort = qual ^. _qualificationShorthand . _CI
|
||||
, qualSchool = qual ^. _qualificationSchool
|
||||
, qualDuration = qual ^. _qualificationValidDuration
|
||||
, qualRenewAuto = qual ^. _qualificationElearningRenews
|
||||
, isReminder = False
|
||||
}
|
||||
}
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
renderLetterPDF usr letter apcIdent Nothing >>= \case
|
||||
Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
|
||||
@ -360,6 +361,6 @@ getAdminTestPdfR = do
|
||||
liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
|
||||
encryptPDF "tomatenmarmelade" pdf >>= \case
|
||||
Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
|
||||
Right encPdf -> do
|
||||
Right encPdf -> do
|
||||
liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
|
||||
sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now
|
||||
|
||||
@ -94,6 +94,7 @@ lrqf2letter LRQF{..}
|
||||
, qualShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
, qualSchool = lrqfQuali ^. _qualificationSchool
|
||||
, qualDuration = lrqfQuali ^. _qualificationValidDuration
|
||||
, qualRenewAuto = lrqfQuali ^. _qualificationElearningRenews
|
||||
, isReminder = lrqfReminder
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
|
||||
@ -102,6 +102,8 @@ mkQualificationAllTable isAdmin = do
|
||||
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
|
||||
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
|
||||
, sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
|
||||
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
|
||||
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
|
||||
|
||||
@ -189,6 +189,8 @@ renewValidQualificationUsers qid reason renewalTime uids =
|
||||
-- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
|
||||
-- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids)
|
||||
get qid >>= \case
|
||||
Just Qualification{qualificationElearningRenews=False}
|
||||
| Just (Right (QualificationRenewELearningBy _)) <- reason -> return 0
|
||||
Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
|
||||
cutoff <- maybe (liftIO getCurrentTime) return renewalTime
|
||||
quEntsAll <- selectValidQualifications qid uids cutoff
|
||||
@ -227,7 +229,7 @@ qualificationUserBlocking ::
|
||||
, Num n
|
||||
) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
|
||||
qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do
|
||||
$logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify]
|
||||
$logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify, "#Users:" <> tshow (length uids), tshow uids] -- this message can get very long on test systems
|
||||
authUsr <- liftHandler maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
let blockTime = fromMaybe now mbBlockTime
|
||||
|
||||
@ -417,12 +417,16 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
|
||||
fltrUserNameUI = fltrUserNameLinkUI
|
||||
|
||||
fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers
|
||||
fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers
|
||||
|
||||
fltrUserNameLinkHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameLinkHdrUI msg mPrev =
|
||||
fltrUserNameLinkHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "user-name") mPrev $ aopt textField (fslI msg)
|
||||
|
||||
fltrUserDisplayNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserDisplayNameHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "user-display-name") mPrev $ aopt textField (fslI msg)
|
||||
|
||||
fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameEmailUI = fltrUserNameEmailHdrUI MsgTableCourseMembers
|
||||
|
||||
@ -686,7 +690,7 @@ fltrRelevantStudyFeaturesTerms queryTermUser = singletonMap "features-terms" . F
|
||||
|
||||
fltrRelevantStudyFeaturesTermsUI :: DBFilterUI
|
||||
fltrRelevantStudyFeaturesTermsUI = fltrStudyTermsUI
|
||||
|
||||
|
||||
fltrRelevantStudyFeaturesDegree :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
|
||||
fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . FilterColumn $ \t criterias ->
|
||||
E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
|
||||
@ -705,7 +709,7 @@ fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" .
|
||||
fltrRelevantStudyFeaturesDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrRelevantStudyFeaturesDegreeUI mPrev =
|
||||
prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgTableDegreeName)
|
||||
|
||||
|
||||
fltrRelevantStudyFeaturesSemester :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
|
||||
fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semester" . FilterColumn $ \t criterias ->
|
||||
E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
|
||||
@ -741,13 +745,13 @@ fltrQualificationHdrUI msg mPrev = prismAForm (singletonFilter "qualification" .
|
||||
|
||||
{-
|
||||
-- colUserCompany :: (HandlerSite (DBCell m) ~ UniWorX, IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do
|
||||
let uid = heu ^. hasEntity . _entityKey
|
||||
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
cell $ toWgt $ mconcat companies
|
||||
@ -756,13 +760,13 @@ colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \
|
||||
-- PROBLEM: how to type sqlCell compatible with dbTable that as actions, i.e. MForm instead of YesodDB?
|
||||
colUserCompany :: (IsDBTable (YesodDB UniWorX) c, HasEntity a User) => Colonnade Sortable a (DBCell (YesodDB UniWorX) c)
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu ->
|
||||
let uid = heu ^. hasEntity . _entityKey in
|
||||
sqlCell $ do
|
||||
let uid = heu ^. hasEntity . _entityKey in
|
||||
sqlCell $ do
|
||||
companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
pure $ toWgt $ mconcat companies
|
||||
@ -803,12 +807,12 @@ fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFol
|
||||
let numCrits = setMapMaybe readMay criterias
|
||||
fltrCName = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName)) needle criterias
|
||||
fltrCShort = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyShorthand)) needle criterias
|
||||
fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits
|
||||
fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits
|
||||
in if null numCrits
|
||||
then fltrCName E.||. fltrCShort
|
||||
else fltrCName E.||. fltrCShort E.||. fltrCno
|
||||
else fltrCName E.||. fltrCShort E.||. fltrCno
|
||||
)
|
||||
where
|
||||
where
|
||||
setFoldMap :: (Text -> Set.Set Text) -> Set.Set Text -> Set.Set Text
|
||||
setFoldMap = foldMap
|
||||
|
||||
@ -825,22 +829,22 @@ fltrCompanyNameNrHdrUI msg mPrev =
|
||||
---------
|
||||
|
||||
|
||||
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
|
||||
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
|
||||
=> (a -> E.SqlExpr (Entity User)) -> Map k (FilterColumn t fs)
|
||||
fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
|
||||
where
|
||||
where
|
||||
fch = FilterColumnHandler $ \case
|
||||
[] -> return (const E.true)
|
||||
cs -> do
|
||||
let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
|
||||
toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
|
||||
maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
>> return (const E.false)
|
||||
(Just (Left err)) -> addMessage Error (someExc2Html err)
|
||||
>> return (const E.false)
|
||||
(Just (Right (null -> True))) -> return (const E.false)
|
||||
(Just (Right apids)) -> return $
|
||||
(Just (Right apids)) -> return $
|
||||
\(queryUser -> user) ->
|
||||
E.exists $ E.from $ \usrAvs ->
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
@ -849,8 +853,8 @@ fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
|
||||
someExc2Html (SomeException e) = text2Html $ tshow e
|
||||
|
||||
fltrAVSCardNosUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrAVSCardNosUI mPrev =
|
||||
prismAForm (singletonFilter "avs-card" ) mPrev $
|
||||
fltrAVSCardNosUI mPrev =
|
||||
prismAForm (singletonFilter "avs-card" ) mPrev $
|
||||
aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
|
||||
|
||||
|
||||
|
||||
@ -336,7 +336,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
|
||||
-- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
|
||||
-- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
|
||||
-- END LMS WORKAROUND 2
|
||||
ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
|
||||
ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser] -- only valid qualifications are truly renewed and only if validDuration is set and elearningRenews is true; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_renew
|
||||
in lrepQry lrFltrSuccess
|
||||
|
||||
@ -25,7 +25,7 @@ dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> H
|
||||
dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
|
||||
<$> getJust jRecipient
|
||||
<*> getJust nQualification
|
||||
<*> getJust nQualification
|
||||
|
||||
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
||||
let entRecipient = Entity jRecipient recipient
|
||||
@ -43,19 +43,19 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
|
||||
|
||||
|
||||
dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpired nQualification jRecipient = do
|
||||
dispatchNotificationQualificationExpired nQualification jRecipient = do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt jRecipient
|
||||
encRecShort <- encrypt jRecipient
|
||||
dbRes <- runDB $ (,,)
|
||||
<$> get jRecipient
|
||||
<*> get nQualification
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
|
||||
case dbRes of
|
||||
case dbRes of
|
||||
( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do
|
||||
now <- liftIO getCurrentTime
|
||||
qub_entry <- entityVal <<$>> runDB (selectRelevantBlock now quId)
|
||||
let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry
|
||||
let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry
|
||||
urender <- getUrlRender
|
||||
let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block
|
||||
qname = CI.original qualificationName
|
||||
@ -94,30 +94,30 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d
|
||||
<*> get nQualification
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
<*> getBy (UniqueLmsQualificationUser nQualification jRecipient)
|
||||
case query of
|
||||
case query of
|
||||
(Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
|
||||
let qname = CI.original qualificationName
|
||||
letter = LetterRenewQualification
|
||||
{ lmsLogin = lmsUserIdent
|
||||
, lmsPin = lmsUserPin
|
||||
, qualHolderID = jRecipient
|
||||
, qualHolderDN = userDisplayName
|
||||
, qualHolderSN = userSurname
|
||||
, qualExpiry = qualificationUserValidUntil
|
||||
, qualId = nQualification
|
||||
, qualName = qname
|
||||
, qualShort = CI.original qualificationShorthand
|
||||
, qualSchool = qualificationSchool
|
||||
, qualDuration = qualificationValidDuration
|
||||
, isReminder = nReminder
|
||||
{ lmsLogin = lmsUserIdent
|
||||
, lmsPin = lmsUserPin
|
||||
, qualHolderID = jRecipient
|
||||
, qualHolderDN = userDisplayName
|
||||
, qualHolderSN = userSurname
|
||||
, qualExpiry = qualificationUserValidUntil
|
||||
, qualId = nQualification
|
||||
, qualName = qname
|
||||
, qualShort = CI.original qualificationShorthand
|
||||
, qualSchool = qualificationSchool
|
||||
, qualDuration = qualificationValidDuration
|
||||
, qualRenewAuto = qualificationElearningRenews
|
||||
, isReminder = nReminder
|
||||
}
|
||||
$logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
|
||||
notifyOk <- sendEmailOrLetter jRecipient letter
|
||||
when notifyOk $ do
|
||||
when notifyOk $ do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ update luid [ LmsUserNotified =. Just now]
|
||||
(_, Nothing, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: Qualification " <> tshow nQualification <> " does not exist!"
|
||||
(Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!"
|
||||
(_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!"
|
||||
(_, _, _, Nothing) -> $logWarnS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!"
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
module Utils.Print.ExpireQualification where
|
||||
|
||||
import Import
|
||||
import Import
|
||||
|
||||
-- import Data.Char as Char
|
||||
-- import qualified Data.Text as Text
|
||||
@ -24,33 +24,28 @@ data LetterExpireQualification = LetterExpireQualification
|
||||
, leqHolderSN :: UserSurname
|
||||
, leqExpiry :: Maybe Day
|
||||
, leqId :: QualificationId
|
||||
, leqName :: Text
|
||||
, leqShort :: Text
|
||||
, leqName :: Text
|
||||
, leqShort :: Text
|
||||
, leqSchool :: SchoolId
|
||||
, leqUrl :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
instance MDLetter LetterExpireQualification where
|
||||
instance MDLetter LetterExpireQualification where
|
||||
encryptPDFfor _ = NoPassword
|
||||
getLetterKind _ = Din5008
|
||||
getLetterEnvelope _ = 'e'
|
||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqShort l
|
||||
|
||||
{-
|
||||
getTemplate LetterExpireQualification{leqShort="F"}
|
||||
= decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
|
||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_generic_expiry.md")
|
||||
-}
|
||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_licence_expiry.md")
|
||||
|
||||
letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
let isSupervised = rcvrId /= leqHolderID
|
||||
(qArea, qFormal, qLicence) = qualificationText lang leqName leqShort
|
||||
in mkMeta $
|
||||
guardMonoid isSupervised
|
||||
[ toMeta "supervisor" userDisplayName
|
||||
[ toMeta "supervisor" userDisplayName
|
||||
] <>
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "licencename" leqName
|
||||
@ -59,14 +54,14 @@ instance MDLetter LetterExpireQualification where
|
||||
, toMeta "subject-meta" leqHolderDN
|
||||
, mbMeta "expiry" (format SelFormatDate <$> leqExpiry)
|
||||
, mbMeta "licence-url" leqUrl
|
||||
, toMeta "de-opening" $ bool ("Guten Tag " <> leqHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
|
||||
, toMeta "en-opening" $ bool ("Dear " <> leqHolderDN <> ",") "Dear supervisor," isSupervised
|
||||
, toMeta "de-subject" [st|Entzug "#{leqShort}" (#{qLicence})|]
|
||||
, toMeta "en-subject" [st|Revocation "#{leqShort}" (#{qLicence})|]
|
||||
, toMeta "de-opening" $ bool [st|Guten Tag #{leqHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised
|
||||
, toMeta "en-opening" $ bool [st|Dear #{leqHolderDN},|] [st|Dear #{userDisplayName},|] isSupervised
|
||||
, toMeta "de-subject" [st|Entzug Fahrberechtigung „#{leqShort}“ (#{qLicence})|]
|
||||
, toMeta "en-subject" [st|Revocation driving licence "#{leqShort}" (#{qLicence})|]
|
||||
, toMeta "qarea" qArea
|
||||
, toMeta "qformal" qFormal
|
||||
, toMeta "qlicence" qLicence
|
||||
]
|
||||
]
|
||||
|
||||
getPJId LetterExpireQualification{..} =
|
||||
PrintJobIdentification
|
||||
@ -78,7 +73,7 @@ instance MDLetter LetterExpireQualification where
|
||||
, pjiCourse = Nothing
|
||||
, pjiQualification = Just leqId
|
||||
, pjiLmsUser = Nothing
|
||||
, pjiFileName = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN
|
||||
, pjiFileName = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN
|
||||
-- let nameRecipient = abbrvName <$> recipient
|
||||
-- nameSender = abbrvName <$> sender
|
||||
-- nameCourse = CI.original . courseShorthand <$> course
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
module Utils.Print.RenewQualification where
|
||||
|
||||
import Import
|
||||
import Import
|
||||
import Text.Hamlet
|
||||
|
||||
import Data.Char as Char
|
||||
@ -19,55 +19,73 @@ import Utils.Print.Letters
|
||||
import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
|
||||
import Handler.Utils.Qualification (computeNewValidDate)
|
||||
|
||||
-- TODO: refactor me and turn me into a qualification property (elearningOnly)
|
||||
qualificationPractical :: Text -> Bool
|
||||
qualificationPractical qshort = "R" == qshort -- TODO
|
||||
|
||||
|
||||
defaultNotice :: Lang -> Text -> Text -> Text -> [Text]
|
||||
defaultNotice l qualName qualShort newExpire
|
||||
| isDe l, qualificationPractical qualShort
|
||||
= [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
|
||||
Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
|
||||
Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen.
|
||||
Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
|
||||
, "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."
|
||||
]
|
||||
| isDe l
|
||||
= [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
|
||||
Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
|
||||
Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen.
|
||||
Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
|
||||
, "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."
|
||||
defaultNotice :: Bool -> Lang -> Text -> Text -> Text -> [Text]
|
||||
defaultNotice renewAuto l qualName qualShort newExpire
|
||||
| isDe l, renewAuto
|
||||
= [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
|
||||
Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
|
||||
Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}.
|
||||
Wir empfehlen die Schulung zeitnah durchzuführen.
|
||||
Sollte bis zum Ablaufdatum das E-Learning nicht innerhalb von 5 Versuchen erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|]
|
||||
, "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung."
|
||||
, "(Please contact us if you prefer letters in English.)"
|
||||
]
|
||||
| otherwise
|
||||
= [ [st|A certificate for your records can only be generated immediately after a successful test.
|
||||
The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed.
|
||||
Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}. We recommend completing the training as soon as possible.
|
||||
The licence irrevocably expires, if the e-learning is not successfully completed by the expiry date or after 5 failed attempts. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
|
||||
| isDe l
|
||||
= [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
|
||||
Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
|
||||
Wir empfehlen die Schulung zeitnah durchzuführen.
|
||||
Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|]
|
||||
, "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung."
|
||||
]
|
||||
| renewAuto
|
||||
= [ [st|A certificate for your records can only be generated immediately after a successful test.
|
||||
The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed.
|
||||
Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}.
|
||||
We recommend completing the training as soon as possible.
|
||||
The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
|
||||
, "Please inform us, if this driving licence is no longer required."
|
||||
, "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)"
|
||||
]
|
||||
|
||||
| otherwise
|
||||
= [ [st|A certificate for your records can only be generated immediately after a successful test.
|
||||
The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed.
|
||||
We recommend completing the training as soon as possible.
|
||||
The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
|
||||
, "Please inform us, if this driving licence is no longer required."
|
||||
, "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)"
|
||||
]
|
||||
|
||||
isAnyDrivingLicence :: Text -> Maybe Text
|
||||
-- isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.replace "-" " " . Text.replace "+" ""
|
||||
isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.map anyNonAlphaToBlank
|
||||
|
||||
anyNonAlphaToBlank :: Char -> Char
|
||||
anyNonAlphaToBlank c
|
||||
| Char.isAlpha c
|
||||
= c
|
||||
| otherwise = ' '
|
||||
|
||||
qualificationText :: Lang -> Text -> Text -> (Text, Text, Text) -- (qarea, qformal, qlicence) i.e. (Rollfeld, Rollfeldfahrberechtigung, Rollfeldführerschein) translated
|
||||
qualificationText l qName@(Text.stripSuffix "führerschein" -> Just qPrefix) qShort
|
||||
| isDe l
|
||||
= (qPrefix, qPrefix <> "fahrberechtigung", qName)
|
||||
| qShort == "F"
|
||||
= ("apron", "apron driving licence", "apron driving licence")
|
||||
| qShort == "R"
|
||||
= ("maneuvering area", "maneuvering area driving licence", "maneuvering area driving licence")
|
||||
| otherwise
|
||||
= (qPrefix, qPrefix <> " driving licence", qName)
|
||||
qualificationText l _qName "GSS"
|
||||
| isDe l
|
||||
= ("Gabelstapler", "Fahrberechtigung Gabelstapler", "Gabelstaplerführerschein")
|
||||
| otherwise
|
||||
= ("Forklift", "forklift driving licence", "forklift driving licence")
|
||||
qualificationText _l qName qShort
|
||||
= (qShort, qName, qName)
|
||||
= ("forklift", "forklift driving licence", "forklift driving licence")
|
||||
qualificationText l qName@(isAnyDrivingLicence -> Just qPrefix) qShort
|
||||
| isDe l
|
||||
= (qPrefix, [st|Fahrberechtigung „#{qShort}“|], qName)
|
||||
| qShort == "F"
|
||||
= ("apron", [st|driving licence "#{qShort}"|], "apron driving licence")
|
||||
| Text.isPrefixOf "R" qShort
|
||||
= ("maneuvering area", [st|driving licence "#{qShort}"|], "maneuvering area driving licence")
|
||||
| otherwise
|
||||
= (qPrefix, qPrefix <> " driving licence", qName)
|
||||
qualificationText l qName qShort
|
||||
| isDe l
|
||||
= (qShort, [st|Fahrberechtigung „#{qShort}“|], qName)
|
||||
| otherwise
|
||||
= (qShort, [st|driving licence "#{qShort}"|], qName)
|
||||
|
||||
|
||||
data LetterRenewQualification = LetterRenewQualification
|
||||
@ -82,25 +100,26 @@ data LetterRenewQualification = LetterRenewQualification
|
||||
, qualShort :: Text
|
||||
, qualSchool :: SchoolId
|
||||
, qualDuration :: Maybe Int
|
||||
, qualRenewAuto :: Bool
|
||||
, isReminder :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- this datatype is specific to this letter only, and just to avoid code duplication for derived data or constants
|
||||
data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text }
|
||||
data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text }
|
||||
deriving (Eq, Show)
|
||||
|
||||
letterRenewalQualificationFData :: LetterRenewQualification -> LetterRenewQualificationData
|
||||
letterRenewalQualificationFData LetterRenewQualification{lmsLogin, lmsPin} = LetterRenewQualificationData{..}
|
||||
where
|
||||
where
|
||||
lmsUrl = "drive.fraport.de"
|
||||
lmsUrlLogin = "https://" <> lmsUrl <> "/?username=" <> lmsIdent
|
||||
lmsUrlPassword = lmsUrlLogin <> "&password=" <> lmsPin
|
||||
lmsIdent = getLmsIdent lmsLogin
|
||||
|
||||
|
||||
instance MDLetter LetterRenewQualification where
|
||||
instance MDLetter LetterRenewQualification where
|
||||
encryptPDFfor _ = PasswordUnderling
|
||||
getLetterKind _ = PinLetter
|
||||
getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
||||
@ -110,22 +129,20 @@ instance MDLetter LetterRenewQualification where
|
||||
let LetterRenewQualificationData{..} = letterRenewalQualificationFData l
|
||||
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
|
||||
|
||||
letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
let LetterRenewQualificationData{..} = letterRenewalQualificationFData l
|
||||
letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
let LetterRenewQualificationData{..} = letterRenewalQualificationFData l
|
||||
isSupervised = rcvrId /= qualHolderID
|
||||
newExpire = computeNewValidDate (fromMaybe 0 qualDuration) qualExpiry
|
||||
(qArea, qFormal, qLicence) = qualificationText lang qualName qualShort
|
||||
in mkMeta $
|
||||
guardMonoid isSupervised
|
||||
[ toMeta "supervisor" userDisplayName
|
||||
, toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
|
||||
, toMeta "en-opening" ("Dear Sir or Madam,"::Text)
|
||||
] <>
|
||||
guardMonoid isReminder
|
||||
[ toMeta "reminder" ("reminder"::Text)
|
||||
] <>
|
||||
guardMonoid (qualificationPractical qualShort)
|
||||
[ toMeta "practical" True
|
||||
guardMonoid (not qualRenewAuto)
|
||||
[ toMeta "practical" True -- note: definied or undefined matters, bool value is unimportant
|
||||
] <>
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "login" lmsIdent
|
||||
@ -136,11 +153,11 @@ instance MDLetter LetterRenewQualification where
|
||||
, mbMeta "validduration" (show <$> qualDuration)
|
||||
, toMeta "url-text" lmsUrl
|
||||
, toMeta "url" lmsUrlPassword -- ok for PDF, since it contains the PIN already
|
||||
, toMeta "notice" $ defaultNotice lang qualName qualShort $ format SelFormatDate newExpire
|
||||
, toMeta "notice" $ defaultNotice qualRenewAuto lang qualName qualShort $ format SelFormatDate newExpire
|
||||
, toMeta "de-subject" [st|Verlängerung Fahrberechtigung „#{qualShort}“ (#{qualName})|]
|
||||
, toMeta "en-subject" [st|Renewal of driving licence „#{qualShort}“ (#{qualName})|]
|
||||
, toMeta "de-opening" $ bool ("Guten Tag " <> qualHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
|
||||
, toMeta "en-opening" $ bool ("Dear " <> qualHolderDN <> ",") "Dear supervisor," isSupervised
|
||||
, toMeta "en-subject" [st|Renewal of driving licence "#{qualShort}" (#{qualName})|]
|
||||
, toMeta "de-opening" $ bool [st|Guten Tag #{qualHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised
|
||||
, toMeta "en-opening" $ bool [st|Dear #{qualHolderDN},|] [st|Dear #{userDisplayName},|] isSupervised
|
||||
, toMeta "qarea" qArea
|
||||
, toMeta "qformal" qFormal
|
||||
, toMeta "qlicence" qLicence
|
||||
@ -156,7 +173,7 @@ instance MDLetter LetterRenewQualification where
|
||||
, pjiCourse = Nothing
|
||||
, pjiQualification = Just qualId
|
||||
, pjiLmsUser = Just lmsLogin
|
||||
, pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
|
||||
, pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
|
||||
-- let nameRecipient = abbrvName <$> recipient
|
||||
-- nameSender = abbrvName <$> sender
|
||||
-- nameCourse = CI.original . courseShorthand <$> course
|
||||
|
||||
@ -1,146 +0,0 @@
|
||||
---
|
||||
### Metadaten, welche hier eingestellt werden:
|
||||
# Absender
|
||||
author: Fraport AG - Fahrerausbildung (AVN-AR)
|
||||
phone: +49 69 690-30306
|
||||
email: fahrerausbildung@fraport.de
|
||||
place: Frankfurt am Main
|
||||
return-address:
|
||||
- 60547 Frankfurt
|
||||
de-opening: Liebe Fahrberechtigungsinhaber,
|
||||
en-opening: Dear driver,
|
||||
de-closing: |
|
||||
Mit freundlichen Grüßen,
|
||||
Ihre Fraport Fahrerausbildung
|
||||
en-closing: |
|
||||
With kind regards,
|
||||
Your Fraport Driver Training
|
||||
encludes:
|
||||
hyperrefoptions: hidelinks
|
||||
|
||||
### Metadaten, welche automatisch ersetzt werden:
|
||||
de-subject: 'Entzug "F" (Vorfeldführerschein)'
|
||||
en-subject: Revocation of apron driving license
|
||||
date: 11.11.1111
|
||||
lang: de-de
|
||||
is-de: true
|
||||
# Emfpänger
|
||||
licenceholder: P. Rüfling
|
||||
address:
|
||||
- E. M. Pfänger
|
||||
- Musterfirma GmbH
|
||||
- Musterstraße 11
|
||||
- 12345 Musterstadt
|
||||
...
|
||||
$if(titleblock)$
|
||||
$titleblock$
|
||||
|
||||
$endif$
|
||||
$for(header-includes)$
|
||||
$header-includes$
|
||||
|
||||
$endfor$
|
||||
$for(include-before)$
|
||||
$include-before$
|
||||
|
||||
$endfor$
|
||||
|
||||
$if(is-de)$
|
||||
|
||||
<!-- deutsche Version des Briefes -->
|
||||
$if(supervisor)$
|
||||
leider hat **$licenceholder$**
|
||||
$else$
|
||||
leider haben Sie
|
||||
$endif$
|
||||
den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bestanden
|
||||
oder die Ablauffrist nicht eingehalten.
|
||||
|
||||
|
||||
Die Qualifikation „Vorfeldführerschein“ ist somit
|
||||
$if(expiry)$
|
||||
seit $expiry$
|
||||
$endif$
|
||||
nicht mehr gültig.
|
||||
|
||||
|
||||
$if(supervisor)$
|
||||
$if(licence-url)$
|
||||
[$licenceholder$]($licence-url$)
|
||||
$else$
|
||||
$licenceholder$
|
||||
$endif$
|
||||
darf
|
||||
$else$
|
||||
Sie dürfen
|
||||
$endif$
|
||||
ab sofort keine Fahrzeuge mehr eigenständig auf dem Vorfeld des Frankfurter Flughafens führen.
|
||||
|
||||
|
||||
Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem Grundkurs Vorfeldführerschein erforderlich.
|
||||
|
||||
$if(supervisor)$
|
||||
Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter:
|
||||
|
||||
Telefon
|
||||
|
||||
: [$phone$](tel:$phone$)
|
||||
|
||||
Email
|
||||
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
|
||||
$endif$
|
||||
|
||||
$else$
|
||||
<!-- englische Version des Briefes -->
|
||||
we regret to inform you that
|
||||
$if(supervisor)$
|
||||
**$licenceholder$**
|
||||
$else$
|
||||
you
|
||||
$endif$
|
||||
did not pass the required knowledge test within the allotted time
|
||||
for the renewal of the apron driving licence.
|
||||
|
||||
|
||||
The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid
|
||||
$if(expiry)$
|
||||
since $expiry$.
|
||||
$else$
|
||||
now.
|
||||
$endif$
|
||||
|
||||
$if(supervisor)$
|
||||
$if(licence-url)$
|
||||
[$licenceholder$]($licence-url$)
|
||||
$else$
|
||||
$licenceholder$
|
||||
$endif$
|
||||
$else$
|
||||
You
|
||||
$endif$
|
||||
may no longer drive a vehicle on the apron of Frankfurt airport, effective immediately.
|
||||
|
||||
|
||||
In order to regain this apron driving licence, a full participation in a
|
||||
basic training course is required.
|
||||
|
||||
$if(supervisor)$
|
||||
Please contact the Fraport driving school team, if you want to book a course:
|
||||
|
||||
Phone
|
||||
|
||||
: [$phone$](tel:$phone$)
|
||||
|
||||
Email
|
||||
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Please contact your employer to book a course for you.
|
||||
$endif$
|
||||
|
||||
$endif$
|
||||
@ -1,3 +0,0 @@
|
||||
SPDX-FileCopyrightText: 2023-24 Steffen Jost <S.Jost@Fraport.de>
|
||||
|
||||
SPDX-License-Identifier: LicenseRef-Fraport-Corporate-Design
|
||||
@ -9,14 +9,16 @@ email: fahrerausbildung@fraport.de
|
||||
place: Frankfurt am Main
|
||||
return-address:
|
||||
- 60547 Frankfurt
|
||||
de-opening: Sehr geehrte Damen und Herren,
|
||||
de-opening: Guten Tag,
|
||||
en-opening: Dear driver,
|
||||
de-closing: |
|
||||
Mit freundlichen Grüßen,
|
||||
Fraport Fahrerausbildung
|
||||
Mit freundlichen Grüßen
|
||||
\vspace{2EX}
|
||||
Fraport Fahrerausbildung
|
||||
en-closing: |
|
||||
With kind regards,
|
||||
Fraport Driver Training
|
||||
With kind regards
|
||||
\vspace{2EX}
|
||||
Fraport Driver Training
|
||||
encludes:
|
||||
hyperrefoptions: hidelinks
|
||||
|
||||
@ -53,11 +55,11 @@ $if(supervisor)$
|
||||
$else$
|
||||
leider haben Sie
|
||||
$endif$
|
||||
den Wissenstest im Rahmen des Recurrent Trainings $qlicence$ nicht bestanden
|
||||
das Recurrent Training $qlicence$ nicht bestanden
|
||||
oder die Ablauffrist nicht eingehalten.
|
||||
|
||||
|
||||
**Die Qualifikation „$qformal$“ ist somit
|
||||
**Die Qualifikation $qformal$ ist somit
|
||||
$if(expiry)$
|
||||
seit $expiry$
|
||||
$endif$
|
||||
@ -74,14 +76,14 @@ darf
|
||||
$else$
|
||||
Sie dürfen
|
||||
$endif$
|
||||
ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Frankfurter Flughafens führen.
|
||||
ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Verkehrsflughafens Frankfurt/Main führen.
|
||||
|
||||
|
||||
Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem
|
||||
Grundkurs $qlicence$ bei der Fahrerausbildung erforderlich.
|
||||
Grundkurs $qlicence$ bei der Fraport Fahrerausbildung erforderlich.
|
||||
|
||||
$if(supervisor)$
|
||||
Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter:
|
||||
|
||||
Hierfür wenden Sie sich bitte an die Fraport Fahrerausbildung unter:
|
||||
|
||||
Telefon
|
||||
|
||||
@ -91,9 +93,6 @@ Email
|
||||
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
|
||||
$endif$
|
||||
|
||||
$else$
|
||||
<!-- englische Version des Briefes -->
|
||||
@ -103,8 +102,9 @@ $if(supervisor)$
|
||||
$else$
|
||||
you
|
||||
$endif$
|
||||
did not pass the required knowledge test within the allotted time
|
||||
for the renewal of the $qlicence$.
|
||||
did not pass the reccurrent training
|
||||
for the renewal of the $qlicence$
|
||||
within the allotted time.
|
||||
|
||||
|
||||
**The qualification „$licencename$“ ($qformal$) is therefore invalid
|
||||
@ -123,13 +123,13 @@ $endif$
|
||||
$else$
|
||||
You
|
||||
$endif$
|
||||
may no longer drive a vehicle on the $qarea$ of Frankfurt airport, effective immediately.
|
||||
may no longer drive a vehicle on the $qarea$ of airport Frankfurt/Main, effective immediately.
|
||||
|
||||
|
||||
In order to regain this $qlicence$, a full participation in a
|
||||
basic training course is required.
|
||||
|
||||
$if(supervisor)$
|
||||
|
||||
Please contact Fraport Driver Training, if you want to book a course:
|
||||
|
||||
Phone
|
||||
@ -140,8 +140,4 @@ Email
|
||||
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Please contact your employer to book a course for you.
|
||||
$endif$
|
||||
|
||||
$endif$
|
||||
|
||||
@ -7,14 +7,16 @@ email: fahrerausbildung@fraport.de
|
||||
place: Frankfurt am Main
|
||||
return-address:
|
||||
- 60547 Frankfurt
|
||||
de-opening: Sehr geehrte Damen und Herren,
|
||||
de-opening: Guten Tag,
|
||||
en-opening: Dear driver,
|
||||
de-closing: |
|
||||
Mit freundlichen Grüßen,
|
||||
Fraport Fahrerausbildung
|
||||
Mit freundlichen Grüßen
|
||||
\vspace{2EX}
|
||||
Fraport Fahrerausbildung
|
||||
en-closing: |
|
||||
With kind regards,
|
||||
Fraport Driver Training
|
||||
With kind regards
|
||||
\vspace{2EX}
|
||||
Fraport Driver Training
|
||||
encludes:
|
||||
hyperrefoptions: colorlinks=false
|
||||
|
||||
@ -22,8 +24,8 @@ hyperrefoptions: colorlinks=false
|
||||
de-subject: 'Verlängerung Fahrberechtigung "F" (Vorfeldführerschein)'
|
||||
en-subject: Renewal of apron driving license
|
||||
qarea: 'Vorfeld'
|
||||
qformal: 'Vorfeldfahrberechtigung'
|
||||
qlicence: 'Vorfeldführerschein'
|
||||
qformal: 'Fahrberechtigung'
|
||||
qlicence: 'Führerschein'
|
||||
url-text: 'drive.fraport.de'
|
||||
url: 'https://drive.fraport.de'
|
||||
date: 11.11.1111
|
||||
@ -85,8 +87,8 @@ $if(supervisor)$
|
||||
Ausschließlich Sie sind berechtigt, die Benutzerdaten an den Schulungsteilnehmer auszuhändigen.
|
||||
$endif$
|
||||
|
||||
Für die Absolvierung der Schulungsmaßnahme werden 1--2 Stunden benötigt.
|
||||
Der Abschluss der Schulung wird automatisch an das System der Fahrerausbildung übermittelt.
|
||||
Für die Absolvierung der Schulungsmaßnahme werden ca. 2 Stunden benötigt.
|
||||
Der Abschluss der Schulung wird automatisch an das System der Fraport Fahrerausbildung übermittelt.
|
||||
|
||||
$if(practical)$
|
||||
Nach erfolgreichem Abschluss der Online-Schulung
|
||||
@ -97,11 +99,11 @@ $if(practical)$
|
||||
$endif$
|
||||
sich von Ihrer Firma zum praktischen Teil der Schulung
|
||||
$if(supervisor)$
|
||||
einplanen lassen.
|
||||
anmelden lassen.
|
||||
$else$
|
||||
einplanen.
|
||||
anmelden.
|
||||
$endif$
|
||||
Im Rahmen der 3--4-stündigen praktischen Auffrischung erfolgen Funkübungen
|
||||
Im Rahmen der ca. 4-stündigen praktischen Auffrischung erfolgen Funkübungen
|
||||
sowie die Durchführung einer Übungsfahrt mit Prüfungscharakter
|
||||
im Start-/Landebahnsystem.
|
||||
$endif$
|
||||
@ -124,9 +126,9 @@ $else$
|
||||
$endif$
|
||||
we require by **$expiry$**, that the
|
||||
$if(practical)$
|
||||
theorectical and paractical
|
||||
theorectical and practical
|
||||
$endif$
|
||||
airport-specific recurrent training at Fraport AG,
|
||||
airport-specific $qarea$ recurrent training at Fraport AG,
|
||||
according to European Union Regulation No. 139/2014,
|
||||
has been completed.
|
||||
|
||||
@ -139,7 +141,7 @@ $if(supervisor)$
|
||||
Only you are authorized to hand over the personal login data to the training participant.
|
||||
$endif$
|
||||
|
||||
The completion of the e-learning will require abut 1--2 hours.
|
||||
The completion of the e-learning will require abut ca. 2 hours.
|
||||
Results will be automatically transmitted to Fraport Driver Training.
|
||||
|
||||
$if(practical)$
|
||||
@ -150,7 +152,7 @@ $if(practical)$
|
||||
your company must schedule you
|
||||
$endif$
|
||||
for the practical part of the training.
|
||||
The 3--4 hour practical refresher includes radio exercises and
|
||||
The ca. 4 hour practical refresher includes radio exercises and
|
||||
an examination-style test drive within the runway system.
|
||||
$endif$
|
||||
|
||||
|
||||
@ -49,6 +49,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
#{icon IconNotificationError}
|
||||
_{MsgLmsErrorNoRefreshElearning}
|
||||
|
||||
<dt .deflist__dt>_{MsgQualificationElearningRenew}
|
||||
<dd .deflist__dd>#{boolSymbol (qualificationElearningRenews quali)}
|
||||
$if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali)
|
||||
<p>
|
||||
#{icon IconNotificationError}
|
||||
_{MsgLmsErrorNoRefreshElearning}
|
||||
|
||||
<section>
|
||||
^{qualificationTable}
|
||||
|
||||
@ -753,9 +753,9 @@ fillDb = do
|
||||
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 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing False True Nothing Nothing
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False True Nothing Nothing
|
||||
qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel)
|
||||
void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user