Merge branch 'fradrive/letter-expiry'
This commit is contained in:
commit
7e09da3594
@ -21,4 +21,5 @@ PrintQualification: Qualifikation
|
||||
PrintPDF !ident-ok: PDF
|
||||
PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
|
||||
PrintLmsUser: E‑Learning Id
|
||||
PrintJobs: Druckaufräge
|
||||
PrintJobs: Druckaufräge
|
||||
PrintLetterType: Brieftypkürzel
|
||||
@ -21,4 +21,5 @@ PrintQualification: Qualification
|
||||
PrintPDF: PDF
|
||||
PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
|
||||
PrintLmsUser: E‑learning id
|
||||
PrintJobs: Print jobs
|
||||
PrintJobs: Print jobs
|
||||
PrintLetterType: Letter type shorthand
|
||||
@ -19,6 +19,7 @@ TableQualificationSapExport: SAP
|
||||
TableQualificationSapExportTooltip: Wird die Qualifikation an das SAP übermittelt? Betrifft nur Benutzer mit Fraport Personalnummer.
|
||||
LmsQualificationValidUntil: Gültig bis
|
||||
TableQualificationLastRefresh: Zuletzt erneuert
|
||||
TableQualificationLastNotified: Letzte Benachrichtigung
|
||||
TableQualificationFirstHeld: Erstmalig
|
||||
TableQualificationBlockedDue: Entzogen
|
||||
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
|
||||
|
||||
@ -19,6 +19,7 @@ TableQualificationSapExport: Sent to SAP
|
||||
TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? Only applies to qualification holder having a Fraport AG personnel number.
|
||||
LmsQualificationValidUntil: Valid until
|
||||
TableQualificationLastRefresh: Last renewed
|
||||
TableQualificationLastNotified: Last notified
|
||||
TableQualificationFirstHeld: First held
|
||||
TableQualificationBlockedDue: Revoked
|
||||
TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
|
||||
|
||||
@ -62,6 +62,7 @@ QualificationUser
|
||||
firstHeld Day -- first time the qualification was earned, should never change
|
||||
blockedDue QualificationBlocked Maybe -- isJust means that the qualification is currently revoked
|
||||
scheduleRenewal Bool default=true -- if false, no automatic renewal is scheduled and the qualification expires
|
||||
lastNotified UTCTime default=now() -- last notficiation about being invalid
|
||||
-- temporärer Entzug vorsehen -- SAP Schnittstelle muss dann angepasst werden
|
||||
-- Begründungsfeld vorsehen
|
||||
UniqueQualificationUser qualification user
|
||||
|
||||
@ -320,7 +320,7 @@ getAdminTestPdfR = do
|
||||
, qualDuration = qual ^. _qualificationValidDuration
|
||||
}
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
renderLetter usr letter apcIdent >>= \case
|
||||
renderLetterPDF usr letter apcIdent >>= \case
|
||||
Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
|
||||
Right pdf -> do
|
||||
liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
|
||||
|
||||
@ -131,6 +131,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
|
||||
qualificationUserLastRefresh = qualificationUserFirstHeld
|
||||
qualificationUserBlockedDue = Nothing
|
||||
qualificationUserScheduleRenewal = True
|
||||
qualificationUserLastNotified = now
|
||||
_ <- upsert QualificationUser{..}
|
||||
[ QualificationUserValidUntil =. qualificationUserValidUntil
|
||||
, QualificationUserLastRefresh =. qualificationUserLastRefresh
|
||||
|
||||
@ -46,20 +46,20 @@ data LRQF = LRQF
|
||||
, lrqfQuali :: Entity Qualification
|
||||
, lrqfIdent :: LmsIdent
|
||||
, lrqfPin :: Text
|
||||
, lrqfExpiry :: Day
|
||||
, lrqfExpiry :: Maybe Day
|
||||
} deriving (Eq, Generic)
|
||||
|
||||
makeRenewalForm :: Maybe LRQF -> Form LRQF
|
||||
makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do
|
||||
-- now_day <- utctDay <$> liftIO getCurrentTime
|
||||
flip (renderAForm FormStandard) html $ LRQF
|
||||
<$> areq textField (fslI MsgLmsUser) (lrqfLetter <$> tmpl)
|
||||
<$> areq textField (fslI MsgPrintLetterType) (lrqfLetter <$> tmpl)
|
||||
<*> areq (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl)
|
||||
<*> aopt (userField False Nothing) (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl)
|
||||
<*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl)
|
||||
<*> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl)
|
||||
<*> areq textField (fslI MsgTableLmsPin) (lrqfPin <$> tmpl)
|
||||
<*> areq dayField (fslI MsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl)
|
||||
<*> aopt dayField (fslI MsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl)
|
||||
where
|
||||
lmsField = convertField LmsIdent getLmsIdent textField
|
||||
|
||||
@ -73,13 +73,14 @@ lrqf2letter LRQF{..}
|
||||
| lrqfLetter == "r" = do
|
||||
usr <- getUser lrqfUser
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
now <- liftIO getCurrentTime
|
||||
let letter = LetterRenewQualificationF
|
||||
{ lmsLogin = lrqfIdent
|
||||
, lmsPin = lrqfPin
|
||||
, qualHolderID = usr ^. _entityKey
|
||||
, qualHolderDN = usr ^. _userDisplayName
|
||||
, qualHolderSN = usr ^. _userSurname
|
||||
, qualExpiry = lrqfExpiry
|
||||
, qualExpiry = fromMaybe (utctDay now) lrqfExpiry
|
||||
, qualId = lrqfQuali ^. _entityKey
|
||||
, qualName = lrqfQuali ^. _qualificationName . _CI
|
||||
, qualShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
@ -87,10 +88,11 @@ lrqf2letter LRQF{..}
|
||||
, qualDuration = lrqfQuali ^. _qualificationValidDuration
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| lrqfLetter == "e" = do
|
||||
| lrqfLetter == "e" || lrqfLetter == "E" = do
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
usr <- getUser lrqfUser
|
||||
usrUuid <- encrypt $ entityKey usr
|
||||
urender <- liftHandler getUrlRender
|
||||
let letter = LetterExpireQualificationF
|
||||
{ leqfHolderUUID = usrUuid
|
||||
, leqfHolderID = usr ^. _entityKey
|
||||
@ -101,6 +103,7 @@ lrqf2letter LRQF{..}
|
||||
, leqfName = lrqfQuali ^. _qualificationName . _CI
|
||||
, leqfShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
, leqfSchool = lrqfQuali ^. _qualificationSchool
|
||||
, leqfUrl = pure . urender $ ForProfileDataR usrUuid
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
|
||||
@ -305,23 +308,31 @@ postPrintSendR = do
|
||||
, lrqfQuali = qual
|
||||
, lrqfIdent = LmsIdent "stuvwxyz"
|
||||
, lrqfPin = "76543210"
|
||||
, lrqfExpiry = succ nowaday
|
||||
, lrqfExpiry = Just $ succ nowaday
|
||||
}
|
||||
def_lrqf = mkLetter <$> mbQual
|
||||
|
||||
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
|
||||
let procFormSend lrqf = do
|
||||
ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
$logErrorS "LPR" msg
|
||||
addMessage Error $ toHtml msg
|
||||
pure False
|
||||
Right (ok, fpath) -> do
|
||||
let response = if null ok then mempty else " Response: " <> ok
|
||||
addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
|
||||
pure True
|
||||
when ok $ redirect PrintCenterR
|
||||
let procFormSend lrqf = case lrqfLetter lrqf of
|
||||
"E" -> (runDB (lrqf2letter lrqf) >>= printHtml (Just uid)) >>= \case
|
||||
Right html -> sendResponse $ toTypedContent html
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
$logErrorS "LPR" msg
|
||||
addMessage Error $ toHtml msg
|
||||
pure ()
|
||||
_ -> do
|
||||
ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
$logErrorS "LPR" msg
|
||||
addMessage Error $ toHtml msg
|
||||
pure False
|
||||
Right (ok, fpath) -> do
|
||||
let response = if null ok then mempty else " Response: " <> ok
|
||||
addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
|
||||
pure True
|
||||
when ok $ redirect PrintCenterR
|
||||
formResult sendResult procFormSend
|
||||
-- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
|
||||
siteLayoutMsg MsgPrintManualRenewal $ do
|
||||
|
||||
@ -339,7 +339,8 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
, single $ sortUserEmail queryUser
|
||||
, single $ sortUserMatriclenr queryUser
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("last-notified" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastNotified))
|
||||
, single ("blocked-due" , SortColumnNeverNull $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
-- , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
-- , single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
@ -520,7 +521,8 @@ postQualificationR sid qsh = do
|
||||
-- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
-- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
|
||||
, sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d
|
||||
]
|
||||
psValidator = def & defaultSorting [SortDescBy "last-refresh"]
|
||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||
|
||||
@ -14,7 +14,7 @@ import Database.Persist.Sql (updateWhereCount)
|
||||
import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
import Handler.Utils.DateTime (toMidnight)
|
||||
|
||||
------------------
|
||||
-- SQL Snippets --
|
||||
@ -57,6 +57,7 @@ upsertQualificationUser qualificationUserQualification qualificationUserLastRef
|
||||
{ qualificationUserFirstHeld = qualificationUserLastRefresh
|
||||
, qualificationUserBlockedDue = Nothing
|
||||
, qualificationUserScheduleRenewal = fromMaybe True mbScheduleRenewal
|
||||
, qualificationUserLastNotified = toMidnight qualificationUserLastRefresh
|
||||
, ..
|
||||
}
|
||||
(
|
||||
|
||||
@ -827,6 +827,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
E.<&> (qualificationUser E.^. QualificationUserFirstHeld)
|
||||
E.<&> (qualificationUser E.^. QualificationUserBlockedDue)
|
||||
E.<&> (qualificationUser E.^. QualificationUserScheduleRenewal)
|
||||
E.<&> (qualificationUser E.^. QualificationUserLastNotified)
|
||||
)
|
||||
(\current excluded ->
|
||||
[ QualificationUserValidUntil E.=. combineWith current excluded E.greatest QualificationUserValidUntil
|
||||
@ -834,6 +835,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
, QualificationUserFirstHeld E.=. combineWith current excluded E.least QualificationUserFirstHeld
|
||||
, QualificationUserBlockedDue E.=. combineWith current excluded E.greatest QualificationUserBlockedDue -- Tested: PostgreSQL GREATEST/LEAST ignores NULL values
|
||||
, QualificationUserScheduleRenewal E.=. combineWith current excluded E.greatest QualificationUserScheduleRenewal
|
||||
, QualificationUserLastNotified E.=. combineWith current excluded E.greatest QualificationUserLastNotified
|
||||
]
|
||||
)
|
||||
deleteWhere [ QualificationUserUser ==. oldUserId ]
|
||||
|
||||
@ -145,7 +145,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
-- end users that expired by doing nothing
|
||||
expiredLearners <- E.select $ do
|
||||
(quser :& luser) <- E.from $
|
||||
E.table @QualificationUser
|
||||
E.table @QualificationUser
|
||||
`E.innerJoin` E.table @LmsUser
|
||||
`E.on` (\(quser :& luser) ->
|
||||
luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
|
||||
@ -158,13 +158,23 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
|
||||
E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners)
|
||||
$logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
|
||||
-- TODO: notify expired used
|
||||
--
|
||||
-- forM_ expiredLearners $ \uid ->
|
||||
-- queueDBJob JobSendNotification
|
||||
-- { jRecipient = uid
|
||||
-- , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = nowaday }
|
||||
-- }
|
||||
|
||||
notifyInvalidDrivers <- E.select $ do
|
||||
quser <- E.from $ E.table @QualificationUser
|
||||
E.where_ $ E.not_ (validQualification nowaday quser)
|
||||
E.&&. (( 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.<. ((quser E.^. QualificationUserBlockedDue) E.->. "day" :: E.SqlExpr (E.Value Day)))
|
||||
))
|
||||
pure (quser E.^. QualificationUserUser)
|
||||
|
||||
forM_ notifyInvalidDrivers $ \(E.Value uid) ->
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = uid
|
||||
, jNotification = NotificationQualificationExpired { nQualification = qid }
|
||||
}
|
||||
|
||||
-- purge outdated LmsUsers
|
||||
case qualificationAuditDuration quali of
|
||||
@ -306,10 +316,11 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
}
|
||||
update luid [LmsUserStatus =. newStatus]
|
||||
void $ qualificationUserBlocking qid [lmsUserUser luser] $ Just $ mkQualificationBlocked QualificationBlockFailedELearning lmsMsgDay
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = lmsUserUser luser
|
||||
, jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = lmsMsgDay }
|
||||
}
|
||||
-- DEACTIVATED FOR NOW; UPON REACTIVATION: DELAY Sending to check for unblocking a few hours later!
|
||||
-- queueDBJob JobSendNotification
|
||||
-- { jRecipient = lmsUserUser luser
|
||||
-- , jNotification = NotificationQualificationExpired { nQualification = qid }
|
||||
-- }
|
||||
|
||||
delete lulid
|
||||
$logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]
|
||||
|
||||
@ -42,25 +42,44 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
|
||||
|
||||
|
||||
dispatchNotificationQualificationExpired :: QualificationId -> Day -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpired nQualification dExpired jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
|
||||
<$> getJust jRecipient
|
||||
<*> getJust nQualification
|
||||
dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpired nQualification jRecipient = do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt jRecipient
|
||||
dbRes <- runDB $ (,,)
|
||||
<$> get jRecipient
|
||||
<*> get nQualification
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
|
||||
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
||||
let entRecipient = Entity jRecipient recipient
|
||||
qname = CI.original qualificationName
|
||||
expiryDate <- formatTimeUser SelFormatDate dExpired $ Just entRecipient
|
||||
|
||||
$logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expired qualification " <> qname
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectQualificationExpired qname
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpired.hamlet")
|
||||
case dbRes of
|
||||
( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do
|
||||
urender <- getUrlRender
|
||||
let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . qualificationBlockedDay) qualificationUserBlockedDue
|
||||
qname = CI.original qualificationName
|
||||
qshort = CI.original qualificationShorthand
|
||||
letter = LetterExpireQualificationF
|
||||
{ leqfHolderUUID = encRecipient
|
||||
, leqfHolderID = jRecipient
|
||||
, leqfHolderDN = userDisplayName
|
||||
, leqfHolderSN = userSurname
|
||||
, leqfExpiry = Just expDay
|
||||
, leqfId = nQualification
|
||||
, leqfName = qname
|
||||
, leqfShort = qshort
|
||||
, leqfSchool = qualificationSchool
|
||||
, leqfUrl = pure . urender $ ForProfileDataR encRecipient
|
||||
}
|
||||
if expDay > utctDay qualificationUserLastNotified
|
||||
then do
|
||||
notifyOk <- sendEmailOrLetter jRecipient letter
|
||||
if notifyOk
|
||||
then do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ update quId [QualificationUserLastNotified =. now]
|
||||
$logInfoS "LMS" $ "Notified " <> tshow encRecipient <> " about expired qualification " <> qname
|
||||
else
|
||||
$logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> qname
|
||||
else $logErrorS "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname
|
||||
_ -> $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> tshow nQualification
|
||||
|
||||
|
||||
-- NOTE: Renewal expects that LmsUser already exists for recipient
|
||||
@ -75,7 +94,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
|
||||
case query of
|
||||
(Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
|
||||
let qname = CI.original qualificationName
|
||||
let letter = LetterRenewQualificationF
|
||||
letter = LetterRenewQualificationF
|
||||
{ lmsLogin = lmsUserIdent
|
||||
, lmsPin = lmsUserPin
|
||||
, qualHolderID = jRecipient
|
||||
|
||||
@ -142,7 +142,7 @@ data Notification
|
||||
| NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
|
||||
| NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
|
||||
| NotificationQualificationExpiry { nQualification :: QualificationId, nExpiry :: Day }
|
||||
| NotificationQualificationExpired { nQualification :: QualificationId, nExpiry :: Day }
|
||||
| NotificationQualificationExpired { nQualification :: QualificationId }
|
||||
| NotificationQualificationRenewal { nQualification :: QualificationId }
|
||||
deriving (Eq, Ord, Show, Read, Generic)
|
||||
|
||||
|
||||
@ -138,7 +138,7 @@ instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where
|
||||
-- where x is an 8 digit AvsCardNo prefixed by zeros, see normalizeAvsCardNo
|
||||
-- and y is the 1 digit AvsVersionNo
|
||||
type AvsVersionNo = Text -- always 1 digit
|
||||
newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits
|
||||
newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits -- TODO: Create Smart Constructor
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField)
|
||||
-- No longer needed:
|
||||
@ -162,7 +162,7 @@ data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVers
|
||||
deriving (Eq, Ord, Generic, NFData)
|
||||
|
||||
tshowAvsFullCardNo :: AvsFullCardNo -> Text
|
||||
tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo avsFullCardNo <> Text.cons '.' avsFullCardVersion
|
||||
tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo (canonical avsFullCardNo) <> Text.cons '.' avsFullCardVersion
|
||||
|
||||
instance Show AvsFullCardNo where
|
||||
show = Text.unpack . tshowAvsFullCardNo
|
||||
@ -170,7 +170,7 @@ instance Show AvsFullCardNo where
|
||||
readAvsFullCardNo :: Text -> Maybe AvsFullCardNo
|
||||
readAvsFullCardNo (Text.span Char.isDigit -> (c, Text.uncons -> Just ('.',v)))
|
||||
| not $ Text.null c, Just (Char.isDigit -> True, "") <- Text.uncons v
|
||||
= Just $ AvsFullCardNo (AvsCardNo c) v
|
||||
= Just $ AvsFullCardNo (AvsCardNo $ normalizeAvsCardNo c) v
|
||||
readAvsFullCardNo _ = Nothing
|
||||
|
||||
instance PersistField AvsFullCardNo where
|
||||
|
||||
@ -5,10 +5,11 @@
|
||||
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
||||
|
||||
module Utils.Print
|
||||
( renderLetter -- used for generating letter pdfs
|
||||
( renderLetterPDF -- used for generating letter pdfs
|
||||
, renderLetters
|
||||
, sendEmailOrLetter -- directly print or sends by email
|
||||
, printLetter -- always send a letter
|
||||
, printHtml -- return letter as Html only
|
||||
, letterApcIdent -- create acknowledge string for APC
|
||||
, letterFileName -- default filename
|
||||
, encryptPDF
|
||||
@ -145,8 +146,8 @@ pdfLaTeX lk doc = do
|
||||
makePDF writerOpts $ appMeta setIsDeFromLang doc
|
||||
|
||||
|
||||
renderLetter :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
|
||||
renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
|
||||
renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
|
||||
renderLetterPDF rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
|
||||
now <- liftIO getCurrentTime
|
||||
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
||||
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||
@ -165,6 +166,30 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
|
||||
actRight e_md $ pdfLaTeX kind
|
||||
|
||||
|
||||
renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html)
|
||||
renderLetterHtml rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
|
||||
now <- liftIO getCurrentTime
|
||||
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
||||
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||
kind = getLetterKind mdl
|
||||
tmpl = getTemplate mdl
|
||||
meta = addApcIdent apcIdent
|
||||
<> letterMeta mdl formatter lang rcvrEnt
|
||||
<> mkMeta
|
||||
[ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
|
||||
toMeta "date" $ format SelFormatDate now
|
||||
, toMeta "rcvr-name" $ rcvr & userDisplayName
|
||||
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
|
||||
--, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
|
||||
]
|
||||
e_md <- mdTemplating tmpl meta
|
||||
actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do
|
||||
html_tmpl <- compileTemplate $ templateHtml kind
|
||||
-- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk)
|
||||
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
||||
, P.writerTemplate = Just html_tmpl }
|
||||
P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md
|
||||
|
||||
-- TODO: apcIdent does not make sense for multiple letters
|
||||
renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
|
||||
renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
|
||||
@ -201,6 +226,15 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
|
||||
-- PrintJobs --
|
||||
---------------
|
||||
|
||||
-- Only used in print-test-handler for PrintSendR
|
||||
printHtml :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text Html)
|
||||
printHtml _senderId (rcvr, letter) = do
|
||||
let rcvrId = rcvr ^. _entityKey
|
||||
encRecipient :: CryptoUUIDUser <- encrypt rcvrId
|
||||
now <- liftIO getCurrentTime
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
renderLetterHtml rcvr letter apcIdent
|
||||
|
||||
-- Only used in print-test-handler for PrintSendR
|
||||
printLetter :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text (Text, FilePath))
|
||||
printLetter senderId (rcvr, letter) = do
|
||||
@ -208,7 +242,7 @@ printLetter senderId (rcvr, letter) = do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt rcvrId
|
||||
now <- liftIO getCurrentTime
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
pdf <- renderLetter rcvr letter apcIdent
|
||||
pdf <- renderLetterPDF rcvr letter apcIdent
|
||||
let protoPji = getPJId letter
|
||||
pji = protoPji
|
||||
{ pjiRecipient = Just rcvrId
|
||||
@ -254,7 +288,7 @@ printLetter'' _ = do
|
||||
-}
|
||||
|
||||
sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool
|
||||
sendEmailOrLetter recipient letter = do
|
||||
sendEmailOrLetter recipient letter = do
|
||||
(underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
|
||||
now <- liftIO getCurrentTime
|
||||
let pjid = getPJId letter
|
||||
@ -262,58 +296,85 @@ sendEmailOrLetter recipient letter = do
|
||||
mailSubject = getMailSubject letter -- these are only needed if sent by email, but we're lazy anyway
|
||||
undername = underling ^. _userDisplayName -- nameHtml' underling
|
||||
undermail = CI.original $ underling ^. _userEmail
|
||||
mr <- getMessageRender
|
||||
let mailSupervisorSubject = SomeMessage $ "[SUPERVISOR] " <> mr mailSubject
|
||||
oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
|
||||
-- mailBody = getMailBody letter formatter
|
||||
renderLetter rcvrEnt letter apcIdent >>= \case
|
||||
_ | preferPost, isNothing postal -> do -- neither email nor postal is known
|
||||
case getPostalPreferenceAndAddress rcvrUsr of
|
||||
(True, Nothing) -> do -- neither email nor postal is known
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Left err -> do -- pdf generation failed
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right pdf | preferPost -> -- send printed letter
|
||||
runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
|
||||
Left err -> do
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
|
||||
|
||||
(True , Just _postal) -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send printed letter
|
||||
Left err -> do -- pdf generation failed
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right (msg,_)
|
||||
| null msg -> return True
|
||||
| otherwise -> do
|
||||
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
|
||||
return True
|
||||
Right pdf -> do -- send email
|
||||
let pdfPass = case encryptPDFfor letter of
|
||||
NoPassword -> Nothing
|
||||
PasswordSupervisor -> rcvrUsr ^. _userPinPassword
|
||||
PasswordUnderling -> underling ^. _userPinPassword
|
||||
attachment <- case pdfPass of
|
||||
Nothing -> return pdf
|
||||
Just passwd -> encryptPDF passwd pdf >>= \case
|
||||
Right encPdf -> return encPdf
|
||||
Left err -> do
|
||||
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
|
||||
$logWarnS "LETTER" msg
|
||||
return pdf
|
||||
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
|
||||
let isSupervised = recipient /= svr
|
||||
supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
|
||||
mailBody = getMailBody letter formatter
|
||||
userMailTdirect svr $ do
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI mailSubject
|
||||
editNotifications <- mkEditNotifications svr
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
|
||||
addPart (File { fileTitle = fName
|
||||
, fileModified = now
|
||||
, fileContent = Just $ yield $ LBS.toStrict attachment
|
||||
} :: PureFile)
|
||||
return True
|
||||
return False
|
||||
Right pdf -> runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
|
||||
Left err -> do
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right (msg,_)
|
||||
| null msg -> return True
|
||||
| otherwise -> do
|
||||
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
|
||||
return True
|
||||
|
||||
(False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached
|
||||
Left err -> do -- pdf generation failed
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right pdf -> do -- pdf generated, send as email attachment now
|
||||
let pdfPass = case encryptPDFfor letter of
|
||||
NoPassword -> Nothing
|
||||
PasswordSupervisor -> rcvrUsr ^. _userPinPassword
|
||||
PasswordUnderling -> underling ^. _userPinPassword
|
||||
attachment <- case pdfPass of
|
||||
Nothing -> return pdf
|
||||
Just passwd -> encryptPDF passwd pdf >>= \case
|
||||
Right encPdf -> return encPdf
|
||||
Left err -> do
|
||||
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
|
||||
$logWarnS "LETTER" msg
|
||||
return pdf
|
||||
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
|
||||
let isSupervised = recipient /= svr
|
||||
supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
|
||||
mailBody <- getMailBody letter formatter
|
||||
userMailTdirect svr $ do
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI mailSubject
|
||||
editNotifications <- mkEditNotifications svr
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
|
||||
addPart (File { fileTitle = fName
|
||||
, fileModified = now
|
||||
, fileContent = Just $ yield $ LBS.toStrict attachment
|
||||
} :: PureFile)
|
||||
return True
|
||||
|
||||
(False, _) -> renderLetterHtml rcvrEnt letter apcIdent >>= \case -- send Email, render letter directly to html
|
||||
Left err -> do -- html generation failed
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". HTML generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right html -> do -- html generated, send directly now
|
||||
let isSupervised = recipient /= svr
|
||||
-- subject = if isSupervised
|
||||
-- then "[SUPERVISOR] " <> mailSubject
|
||||
-- else mailSubject
|
||||
subject = if isSupervised
|
||||
then mailSupervisorSubject
|
||||
else mailSubject
|
||||
userMailTdirect svr $ do
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI subject
|
||||
-- when isSupervised $ mapSubject ("[SUPERVISOR] " <>)
|
||||
addHtmlMarkdownAlternatives html
|
||||
return True
|
||||
return $ or oks
|
||||
|
||||
|
||||
|
||||
@ -24,19 +24,21 @@ data LetterExpireQualificationF = LetterExpireQualificationF
|
||||
, leqfHolderID :: UserId
|
||||
, leqfHolderDN :: UserDisplayName
|
||||
, leqfHolderSN :: UserSurname
|
||||
, leqfExpiry :: Day
|
||||
, leqfExpiry :: Maybe Day
|
||||
, leqfId :: QualificationId
|
||||
, leqfName :: Text
|
||||
, leqfShort :: Text
|
||||
, leqfSchool :: SchoolId
|
||||
, leqfSchool :: SchoolId
|
||||
, leqfUrl :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- TODO: use markdown to generate the Letter
|
||||
instance MDMail LetterExpireQualificationF where
|
||||
attachPDFLetter _ = False
|
||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l
|
||||
getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } =
|
||||
let expiryDate = format SelFormatDate leqfExpiry
|
||||
getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $
|
||||
let expiryDate = format SelFormatDate <$> leqfExpiry
|
||||
userDisplayName = leqfHolderDN
|
||||
userSurname = leqfHolderSN
|
||||
qualificationName = leqfName
|
||||
@ -46,6 +48,12 @@ instance MDMail LetterExpireQualificationF where
|
||||
ihamletSomeMessage _ _ _ = (mempty :: Html) -- TODO: use markdown for letter
|
||||
editNotifications = () -- TODO: use markdown for letter
|
||||
in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
|
||||
-- const $ const html
|
||||
-- Html -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
|
||||
-- foo _ _ html -> html
|
||||
-- [shamlet|#Ansprache #{html}|] um Html umzuwandeln!
|
||||
--
|
||||
|
||||
|
||||
instance MDLetter LetterExpireQualificationF where
|
||||
encryptPDFfor _ = NoPassword
|
||||
@ -63,7 +71,8 @@ instance MDLetter LetterExpireQualificationF where
|
||||
] <>
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "licenceholder" leqfHolderDN
|
||||
, toMeta "expiry" (format SelFormatDate leqfExpiry)
|
||||
, mbMeta "expiry" (format SelFormatDate <$> leqfExpiry)
|
||||
, mbMeta "licence-url" leqfUrl
|
||||
]
|
||||
|
||||
getPJId LetterExpireQualificationF{..} =
|
||||
|
||||
@ -152,6 +152,9 @@ paperKind Plain = "a4wht" -- Ohne Logo
|
||||
paperKind Din5008 = "a4log" -- Mit Logo
|
||||
paperKind PlainLogo = "a4log"
|
||||
|
||||
templateHtml :: LetterKind -> Text
|
||||
-- templateHtml Din5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")
|
||||
templateHtml _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")
|
||||
|
||||
|
||||
---------------
|
||||
@ -217,7 +220,7 @@ data EncryptPDFfor = NoPassword | PasswordSupervisor | PasswordUnderling
|
||||
|
||||
class MDLetter l where
|
||||
letterMeta :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta -- formatter/lang for individual receiver, set Meta "lang" for individually translated letters
|
||||
-- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver
|
||||
-- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetterPDF for each receiver
|
||||
getPJId :: l -> PrintJobIdentification
|
||||
getLetterEnvelope :: l -> Char
|
||||
getLetterKind :: l -> LetterKind
|
||||
@ -249,4 +252,7 @@ getApcIdent _ = Nothing
|
||||
|
||||
class MDMail l where --
|
||||
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
|
||||
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
|
||||
getMailBody :: (MonadHandler m) => l -> DateTimeFormatter -> m (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -- only used if letter is sent by email as pdf attachment
|
||||
-- | should the email also contain the letter as a PDF attachment?
|
||||
attachPDFLetter :: l -> Bool
|
||||
attachPDFLetter = const True
|
||||
|
||||
@ -48,7 +48,7 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
|
||||
|
||||
instance MDMail LetterRenewQualificationF where
|
||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
||||
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
|
||||
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = return $
|
||||
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
||||
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
|
||||
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
de-subject: 'Entzug "F" (Vorfeldführerschein)'
|
||||
en-subject: Revocation of apron driving license
|
||||
author: Fraport AG - Fahrerausbildung (AVN-AR)
|
||||
phone: +49 69 690-28467
|
||||
phone: +49 69 690-30306
|
||||
email: fahrerausbildung@fraport.de
|
||||
place: Frankfurt am Main
|
||||
return-address:
|
||||
@ -22,7 +22,6 @@ hyperrefoptions: hidelinks
|
||||
|
||||
### Metadaten, welche automatisch ersetzt werden:
|
||||
date: 11.11.1111
|
||||
expiry: 00.00.0000
|
||||
lang: de-de
|
||||
is-de: true
|
||||
# Emfpänger
|
||||
@ -58,11 +57,20 @@ den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bes
|
||||
oder die Ablauffrist nicht eingehalten.
|
||||
|
||||
|
||||
Die Qualifikation „Vorfeldführerschein“ ist somit nicht mehr gültig.
|
||||
Die Qualifikation „Vorfeldführerschein“ ist somit
|
||||
$if(expiry)$
|
||||
seit $expiry$
|
||||
$endif$
|
||||
nicht mehr gültig.
|
||||
|
||||
|
||||
$if(supervisor)$
|
||||
$licenceholder$ darf
|
||||
$if(licence-url)$
|
||||
[$licenceholder$]($licence-url$)
|
||||
$else$
|
||||
$licenceholder$
|
||||
$endif$
|
||||
darf
|
||||
$else$
|
||||
Sie dürfen
|
||||
$endif$
|
||||
@ -80,7 +88,7 @@ Telefon
|
||||
|
||||
Email
|
||||
|
||||
: $email$
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
|
||||
@ -98,11 +106,19 @@ 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 now.
|
||||
|
||||
The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid
|
||||
$if(expiry)$
|
||||
since $expiry$.
|
||||
$else$
|
||||
now.
|
||||
$endif$
|
||||
|
||||
$if(supervisor)$
|
||||
$licenceholder$
|
||||
$if(licence-url)$
|
||||
[$licenceholder$]($licence-url$)
|
||||
$else$
|
||||
$licenceholder$
|
||||
$endif$
|
||||
$else$
|
||||
You
|
||||
$endif$
|
||||
@ -121,7 +137,7 @@ Phone
|
||||
|
||||
Email
|
||||
|
||||
: $email$
|
||||
: [$email$](mailto:$email$)
|
||||
|
||||
$else$
|
||||
Please contact your employer to book a course for you.
|
||||
|
||||
262
templates/letter/generic_template.html
Normal file
262
templates/letter/generic_template.html
Normal file
@ -0,0 +1,262 @@
|
||||
<!DOCTYPE html>
|
||||
<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"$lang$\" xml:lang=\"$lang$\"$if(dir)$ dir=\"$dir$\"$endif$>
|
||||
|
||||
<head>
|
||||
<meta charset=\"utf-8\" />
|
||||
<meta name=\"generator\" content=\"pandoc\" />
|
||||
<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0, user-scalable=yes\" />
|
||||
$for(author-meta)$ <meta name=\"author\" content=\"$author-meta$\" /> $endfor$
|
||||
$if(date-meta)$ <meta name=\"dcterms.date\" content=\"$date-meta$\" /> $endif$
|
||||
$if(keywords)$ <meta name=\"keywords\" content=\"$for(keywords)$$keywords$$sep$, $endfor$\" />
|
||||
$endif$
|
||||
<title>$if(title-prefix)$$title-prefix$ \8211 $endif$$pagetitle$</title>
|
||||
<style>
|
||||
$if(document-css)$
|
||||
html {
|
||||
$if(mainfont)$
|
||||
font-family: $mainfont$;
|
||||
$endif$
|
||||
$if(fontsize)$
|
||||
font-size: $fontsize$;
|
||||
$endif$
|
||||
$if(linestretch)$
|
||||
line-height: $linestretch$;
|
||||
$endif$
|
||||
color: $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
|
||||
background-color: $if(backgroundcolor)$$backgroundcolor$$else$#fdfdfd$endif$;
|
||||
}
|
||||
body {
|
||||
margin: 0 auto;
|
||||
max-width: $if(maxwidth)$$maxwidth$$else$36em$endif$;
|
||||
padding-left: $if(margin-left)$$margin-left$$else$50px$endif$;
|
||||
padding-right: $if(margin-right)$$margin-right$$else$50px$endif$;
|
||||
padding-top: $if(margin-top)$$margin-top$$else$50px$endif$;
|
||||
padding-bottom: $if(margin-bottom)$$margin-bottom$$else$50px$endif$;
|
||||
hyphens: auto;
|
||||
overflow-wrap: break-word;
|
||||
text-rendering: optimizeLegibility;
|
||||
font-kerning: normal;
|
||||
}
|
||||
@media (max-width: 600px) {
|
||||
body {
|
||||
font-size: 0.9em;
|
||||
padding: 12px;
|
||||
}
|
||||
h1 {
|
||||
font-size: 1.8em;
|
||||
}
|
||||
}
|
||||
@media print {
|
||||
html {
|
||||
background-color: $if(backgroundcolor)$$backgroundcolor$$else$white$endif$;
|
||||
}
|
||||
body {
|
||||
background-color: transparent;
|
||||
color: black;
|
||||
font-size: 12pt;
|
||||
}
|
||||
p, h2, h3 {
|
||||
orphans: 3;
|
||||
widows: 3;
|
||||
}
|
||||
h2, h3, h4 {
|
||||
page-break-after: avoid;
|
||||
}
|
||||
}
|
||||
p {
|
||||
margin: 1em 0;
|
||||
}
|
||||
a {
|
||||
color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$;
|
||||
}
|
||||
a:visited {
|
||||
color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$;
|
||||
}
|
||||
img {
|
||||
max-width: 100%;
|
||||
}
|
||||
h1, h2, h3, h4, h5, h6 {
|
||||
margin-top: 1.4em;
|
||||
}
|
||||
h5, h6 {
|
||||
font-size: 1em;
|
||||
font-style: italic;
|
||||
}
|
||||
h6 {
|
||||
font-weight: normal;
|
||||
}
|
||||
ol, ul {
|
||||
padding-left: 1.7em;
|
||||
margin-top: 1em;
|
||||
}
|
||||
li > ol, li > ul {
|
||||
margin-top: 0;
|
||||
}
|
||||
blockquote {
|
||||
margin: 1em 0 1em 1.7em;
|
||||
padding-left: 1em;
|
||||
border-left: 2px solid #e6e6e6;
|
||||
color: #606060;
|
||||
}
|
||||
$if(abstract)$
|
||||
div.abstract {
|
||||
margin: 2em 2em 2em 2em;
|
||||
text-align: left;
|
||||
font-size: 85%;
|
||||
}
|
||||
div.abstract-title {
|
||||
font-weight: bold;
|
||||
text-align: center;
|
||||
padding: 0;
|
||||
margin-bottom: 0.5em;
|
||||
}
|
||||
$endif$
|
||||
code {
|
||||
font-family: $if(monofont)$$monofont$$else$Menlo, Monaco, Consolas, 'Lucida Console', monospace$endif$;
|
||||
$if(monobackgroundcolor)$
|
||||
background-color: $monobackgroundcolor$;
|
||||
padding: .2em .4em;
|
||||
$endif$
|
||||
font-size: 85%;
|
||||
margin: 0;
|
||||
hyphens: manual;
|
||||
}
|
||||
pre {
|
||||
margin: 1em 0;
|
||||
$if(monobackgroundcolor)$
|
||||
background-color: $monobackgroundcolor$;
|
||||
padding: 1em;
|
||||
$endif$
|
||||
overflow: auto;
|
||||
}
|
||||
pre code {
|
||||
padding: 0;
|
||||
overflow: visible;
|
||||
overflow-wrap: normal;
|
||||
}
|
||||
.sourceCode {
|
||||
background-color: transparent;
|
||||
overflow: visible;
|
||||
}
|
||||
hr {
|
||||
background-color: #1a1a1a;
|
||||
border: none;
|
||||
height: 1px;
|
||||
margin: 1em 0;
|
||||
}
|
||||
table {
|
||||
margin: 1em 0;
|
||||
border-collapse: collapse;
|
||||
width: 100%;
|
||||
overflow-x: auto;
|
||||
display: block;
|
||||
font-variant-numeric: lining-nums tabular-nums;
|
||||
}
|
||||
table caption {
|
||||
margin-bottom: 0.75em;
|
||||
}
|
||||
tbody {
|
||||
margin-top: 0.5em;
|
||||
border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
|
||||
border-bottom: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
|
||||
}
|
||||
th {
|
||||
border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$;
|
||||
padding: 0.25em 0.5em 0.25em 0.5em;
|
||||
}
|
||||
td {
|
||||
padding: 0.125em 0.5em 0.25em 0.5em;
|
||||
}
|
||||
header {
|
||||
margin-bottom: 4em;
|
||||
text-align: center;
|
||||
}
|
||||
#TOC li {
|
||||
list-style: none;
|
||||
}
|
||||
#TOC ul {
|
||||
padding-left: 1.3em;
|
||||
}
|
||||
#TOC > ul {
|
||||
padding-left: 0;
|
||||
}
|
||||
#TOC a:not(:hover) {
|
||||
text-decoration: none;
|
||||
}
|
||||
$endif$
|
||||
code{white-space: pre-wrap;}
|
||||
span.smallcaps{font-variant: small-caps;}
|
||||
div.columns{display: flex; gap: min(4vw, 1.5em);}
|
||||
div.column{flex: auto; overflow-x: auto;}
|
||||
div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
|
||||
/* The extra [class] is a hack that increases specificity enough to
|
||||
override a similar rule in reveal.js */
|
||||
ul.task-list[class]{list-style: none;}
|
||||
ul.task-list li input[type="checkbox"] {
|
||||
font-size: inherit;
|
||||
width: 0.8em;
|
||||
margin: 0 0.8em 0.2em -1.6em;
|
||||
vertical-align: middle;
|
||||
}
|
||||
$if(quotes)$
|
||||
q { quotes: "“" "”" "‘" "’"; }
|
||||
$endif$
|
||||
$if(displaymath-css)$
|
||||
.display.math{display: block; text-align: center; margin: 0.5rem auto;}
|
||||
$endif$
|
||||
$if(highlighting-css)$
|
||||
/* CSS for syntax highlighting */
|
||||
$highlighting-css$
|
||||
$endif$
|
||||
$if(csl-css)$
|
||||
/* CSS for citations */
|
||||
div.csl-bib-body { }
|
||||
div.csl-entry {
|
||||
clear: both;
|
||||
$if(csl-entry-spacing)$
|
||||
margin-bottom: $csl-entry-spacing$;
|
||||
$endif$
|
||||
}
|
||||
.hanging-indent div.csl-entry {
|
||||
margin-left:2em;
|
||||
text-indent:-2em;
|
||||
}
|
||||
div.csl-left-margin {
|
||||
min-width:2em;
|
||||
float:left;
|
||||
}
|
||||
div.csl-right-inline {
|
||||
margin-left:2em;
|
||||
padding-left:1em;
|
||||
}
|
||||
div.csl-indent {
|
||||
margin-left: 2em;
|
||||
}
|
||||
$endif$
|
||||
</style>
|
||||
$for(css)$ <link rel=\"stylesheet\" href=\"$css$\" /> $endfor$
|
||||
$if(math)$ $math$ $endif$
|
||||
<!--[if lt IE 9]> <script src=\"//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js\"></script> <![endif]-->
|
||||
$for(header-includes)$ $header-includes$ $endfor$
|
||||
</head>
|
||||
|
||||
<body>
|
||||
$for(include-before)$ $include-before$ $endfor$
|
||||
$if(title)$ <header id=\"title-block-header\">
|
||||
<h1 class=\"title\">$title$</h1> $if(subtitle)$ <p class=\"subtitle\">$subtitle$</p> $endif$ $for(author)$ <p
|
||||
class=\"author\">$author$</p> $endfor$ $if(date)$ <p class=\"date\">$date$</p> $endif$
|
||||
</header>
|
||||
$endif$
|
||||
$if(toc)$ <nav id=\"$idprefix$TOC\" role=\"doc-toc\">
|
||||
$if(toc-title)$ <h2 id=\"$idprefix$toc-title\"> $toc-title$</h2> $endif$
|
||||
$table-of-contents$ </nav>
|
||||
$endif$
|
||||
|
||||
$if(is-de)$ $de-opening$ $else$ $en-opening$ $endif$
|
||||
$body$
|
||||
$if(is-de)$ $de-closing$ $else$ $en-closing$ $endif$
|
||||
|
||||
$for(include-after)$ $include-after$ $endfor$
|
||||
</body>
|
||||
|
||||
</html>
|
||||
@ -29,8 +29,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
#{qualificationName}
|
||||
<dt>_{SomeMessage MsgLmsUser}
|
||||
<dd>#{nameHtml userDisplayName userSurname}
|
||||
<dt>_{SomeMessage MsgQualificationExpired}
|
||||
<dd>#{expiryDate}
|
||||
$maybe expDate <- expiryDate
|
||||
<dt>_{SomeMessage MsgQualificationExpired}
|
||||
<dd>#{expDate}
|
||||
|
||||
|
||||
^{ihamletSomeMessage editNotifications}
|
||||
|
||||
@ -691,23 +691,23 @@ fillDb = do
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True Nothing Nothing
|
||||
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True -- TODO: better dates!
|
||||
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True
|
||||
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) Nothing False
|
||||
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True
|
||||
void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200) Nothing True
|
||||
void . insert' $ QualificationUser tinaTester qid_f (n_day 3) (n_day $ -60) (n_day $ -250) (Just $ QualificationBlocked (n_day $ -7) "Some long explanation for the block!") False
|
||||
void . insert' $ QualificationUser tinaTester qid_r (n_day 3) (n_day $ -60) (n_day $ -250) Nothing False
|
||||
void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9) Nothing True
|
||||
void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2) Nothing False
|
||||
-- void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2) Nothing True
|
||||
void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True
|
||||
void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7) Nothing True
|
||||
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True (n_day' $ -9)
|
||||
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) Nothing False (n_day' $ -1)
|
||||
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -9)
|
||||
void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200) Nothing True (n_day' $ -2)
|
||||
void . insert' $ QualificationUser tinaTester qid_f (n_day 3) (n_day $ -60) (n_day $ -250) (Just $ QualificationBlocked (n_day $ -7) "Some long explanation for the block!") False (n_day' $ -9)
|
||||
void . insert' $ QualificationUser tinaTester qid_r (n_day 3) (n_day $ -60) (n_day $ -250) Nothing False (n_day' $ -3)
|
||||
void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9) Nothing True (n_day' $ -4)
|
||||
void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2) Nothing False (n_day' $ -6)
|
||||
-- void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -9)
|
||||
void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -7)
|
||||
void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7) Nothing True (n_day' $ -8)
|
||||
qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal)
|
||||
<$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser]
|
||||
insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True | Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers]
|
||||
insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True (n_day' $ -11)| Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers]
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user