chore(qualifications): expiry letter for test sending created
This commit is contained in:
parent
6ddf1b1646
commit
f6485a367e
@ -2,7 +2,7 @@
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeApplications, ExistentialQuantification #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Handler.PrintCenter
|
||||
@ -25,6 +25,8 @@ import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import Utils.Print
|
||||
import Utils.Print.Letters (MDLetter)
|
||||
|
||||
-- import Data.Aeson (encode)
|
||||
import qualified Data.Text as Text
|
||||
-- import qualified Data.Set as Set
|
||||
@ -37,20 +39,24 @@ import Handler.Utils
|
||||
single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
data SomeLetter = forall l . (MDLetter l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
|
||||
|
||||
data LRQF = LRQF
|
||||
{ lrqfUser :: Either UserEmail UserId
|
||||
, lrqfSuper :: Maybe (Either UserEmail UserId)
|
||||
, lrqfQuali :: Entity Qualification
|
||||
, lrqfIdent :: LmsIdent
|
||||
, lrqfPin :: Text
|
||||
, lrqfExpiry:: Day
|
||||
{ lrqfLetter :: Text
|
||||
, lrqfUser :: Either UserEmail UserId
|
||||
, lrqfSuper :: Maybe (Either UserEmail UserId)
|
||||
, lrqfQuali :: Entity Qualification
|
||||
, lrqfIdent :: LmsIdent
|
||||
, lrqfPin :: Text
|
||||
, lrqfExpiry :: 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 (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl)
|
||||
<$> areq textField (fslI MsgLmsUser) (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)
|
||||
@ -64,8 +70,9 @@ validateLetterRenewQualificationF = -- do
|
||||
-- LRQF{..} <- State.get
|
||||
return ()
|
||||
|
||||
lrqf2letter :: LRQF -> DB (Entity User, LetterRenewQualificationF)
|
||||
lrqf2letter LRQF{..} = do
|
||||
lrqf2letter :: LRQF -> DB (Entity User, SomeLetter)
|
||||
lrqf2letter LRQF{..}
|
||||
| lrqfLetter == "r" = do
|
||||
usr <- getUser lrqfUser
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
let letter = LetterRenewQualificationF
|
||||
@ -81,7 +88,24 @@ lrqf2letter LRQF{..} = do
|
||||
, qualSchool = lrqfQuali ^. _qualificationSchool
|
||||
, qualDuration = lrqfQuali ^. _qualificationValidDuration
|
||||
}
|
||||
return (fromMaybe usr rcvr, letter)
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| lrqfLetter == "e" = do
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
usr <- getUser lrqfUser
|
||||
usrUuid <- encrypt $ entityKey usr
|
||||
let letter = LetterExpireQualificationF
|
||||
{ leqfHolderUUID = usrUuid
|
||||
, leqfHolderID = usr ^. _entityKey
|
||||
, leqfHolderDN = usr ^. _userDisplayName
|
||||
, leqfHolderSN = usr ^. _userSurname
|
||||
, leqfExpiry = lrqfExpiry
|
||||
, leqfId = lrqfQuali ^. _entityKey
|
||||
, leqfName = lrqfQuali ^. _qualificationName . _CI
|
||||
, leqfShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
, leqfSchool = lrqfQuali ^. _qualificationSchool
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
|
||||
where
|
||||
getUser :: Either UserEmail UserId -> DB (Entity User)
|
||||
getUser (Right uid) = getEntity404 uid
|
||||
@ -175,7 +199,7 @@ mkPJTable = do
|
||||
, sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
, sortable (Just "course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell
|
||||
, sortable (Just "qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell
|
||||
, sortable (Just "lmsid") (i18nCell MsgPrintLmsUser) $ \( view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap textCell (getLmsIdent <$> l)
|
||||
, sortable (Just "lmsid") (i18nCell MsgPrintLmsUser) $ \( view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap (textCell . getLmsIdent) l
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single ("name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName))
|
||||
@ -277,7 +301,8 @@ postPrintSendR = do
|
||||
let nowaday = utctDay now
|
||||
uid = usr ^. _entityKey
|
||||
mkLetter qual = LRQF
|
||||
{ lrqfUser = Right uid
|
||||
{ lrqfLetter = "r"
|
||||
, lrqfUser = Right uid
|
||||
, lrqfSuper = Nothing
|
||||
, lrqfQuali = qual
|
||||
, lrqfIdent = LmsIdent "stuvwxyz"
|
||||
@ -288,7 +313,9 @@ postPrintSendR = do
|
||||
|
||||
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
|
||||
let procFormSend lrqf = do
|
||||
ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
|
||||
ok <- (runDB (lrqf2letter lrqf) >>= \case
|
||||
(entUsr, SomeLetter l) -> printLetter (Just uid) (entUsr, l)
|
||||
) >>= \case
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
$logErrorS "LPR" msg
|
||||
|
||||
@ -16,8 +16,11 @@ module Utils.Print
|
||||
-- , compileTemplate, makePDF
|
||||
, _Meta, addMeta
|
||||
, toMeta, mbMeta -- single values
|
||||
, mkMeta, appMeta, applyMetas -- multiple values
|
||||
, mkMeta, appMeta, applyMetas -- multiple values
|
||||
-- , MDMail
|
||||
-- , MDLetter
|
||||
, LetterRenewQualificationF(..)
|
||||
, LetterExpireQualificationF(..)
|
||||
-- , LetterCourseCertificate()
|
||||
, makeCourseCertificates
|
||||
) where
|
||||
@ -53,6 +56,7 @@ import Jobs.Handler.SendNotification.Utils
|
||||
import Utils.Print.Instances ()
|
||||
import Utils.Print.Letters
|
||||
import Utils.Print.RenewQualification
|
||||
import Utils.Print.ExpireQualification
|
||||
import Utils.Print.CourseCertificate
|
||||
|
||||
|
||||
|
||||
@ -9,8 +9,8 @@ module Utils.Print.ExpireQualification where
|
||||
import Import
|
||||
import Text.Hamlet
|
||||
|
||||
import Data.Char as Char
|
||||
import qualified Data.Text as Text
|
||||
-- import Data.Char as Char
|
||||
-- import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Data.FileEmbed (embedFile)
|
||||
@ -20,33 +20,41 @@ import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
|
||||
|
||||
|
||||
data LetterExpireQualificationF = LetterExpireQualificationF
|
||||
{ leqfHolderID :: UserId
|
||||
{ leqfHolderUUID:: CryptoUUIDUser
|
||||
, leqfHolderID :: UserId
|
||||
, leqfHolderDN :: UserDisplayName
|
||||
, leqfHolderSN :: UserSurname
|
||||
, leqfExpiry :: Day
|
||||
, leqfId :: QualificationId
|
||||
, leqfName :: Text
|
||||
, leqfShort :: Text
|
||||
, leqfSchool :: SchoolId
|
||||
, leqfName :: Text
|
||||
, leqfShort :: Text
|
||||
, leqfSchool :: SchoolId
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- TODO:
|
||||
-- instance MDMail LetterExpireQualificationF where
|
||||
-- getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
||||
-- getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
|
||||
-- let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
||||
-- in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
|
||||
-- TODO: use markdown to generate the Letter
|
||||
instance MDMail LetterExpireQualificationF where
|
||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l
|
||||
getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } =
|
||||
let expiryDate = format SelFormatDate leqfExpiry
|
||||
userDisplayName = leqfHolderDN
|
||||
userSurname = leqfHolderSN
|
||||
qualificationName = leqfName
|
||||
qualificationShorthand = CI.mk leqfShort
|
||||
qualificationSchool = leqfSchool
|
||||
qname = qualificationName
|
||||
ihamletSomeMessage _ _ _ = (mempty :: Html) -- TODO: use markdown for letter
|
||||
editNotifications = () -- TODO: use markdown for letter
|
||||
in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
|
||||
|
||||
instance MDLetter LetterExpireQualificationF where
|
||||
encrypPDFfor _ = NoPassword
|
||||
getLetterKind _ = Din5008
|
||||
getLetterEnvelope l = 'e'
|
||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
||||
getLetterEnvelope _ = 'e'
|
||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
|
||||
|
||||
letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
||||
isSupervised = rcvrId /= qualHolderID
|
||||
letterMeta LetterExpireQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
let isSupervised = rcvrId /= leqfHolderID
|
||||
in mkMeta $
|
||||
guardMonoid isSupervised
|
||||
[ toMeta "supervisor" userDisplayName
|
||||
@ -54,25 +62,20 @@ instance MDLetter LetterExpireQualificationF where
|
||||
, toMeta "en-opening" ("Dear Sir or Madam,"::Text)
|
||||
] <>
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "login" lmsIdent
|
||||
, toMeta "pin" lmsPin
|
||||
, toMeta "examinee" qualHolderDN
|
||||
, toMeta "expiry" (format SelFormatDate qualExpiry)
|
||||
, mbMeta "validduration" (show <$> qualDuration)
|
||||
, toMeta "url-text" lmsUrl
|
||||
, toMeta "url" lmsUrlLogin
|
||||
, toMeta "licenceholder" leqfHolderDN
|
||||
, toMeta "expiry" (format SelFormatDate leqfExpiry)
|
||||
]
|
||||
|
||||
getPJId LetterRenewQualificationF{..} =
|
||||
getPJId LetterExpireQualificationF{..} =
|
||||
PrintJobIdentification
|
||||
{ pjiName = "Renewal"
|
||||
, pjiApcAcknowledge = "lms-" <> getLmsIdent lmsLogin
|
||||
{ pjiName = "Expiry"
|
||||
, pjiApcAcknowledge = "exp-" <> tshow (ciphertext leqfHolderUUID)
|
||||
, pjiRecipient = Nothing -- to be filled later
|
||||
, pjiSender = Nothing
|
||||
, pjiCourse = Nothing
|
||||
, pjiQualification = Just qualId
|
||||
, pjiLmsUser = Just lmsLogin
|
||||
, pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
|
||||
, pjiQualification = Just leqfId
|
||||
, pjiLmsUser = Nothing
|
||||
, pjiFileName = "expire_" <> CI.original (unSchoolKey leqfSchool) <> "-" <> leqfShort <> "_" <> leqfHolderSN
|
||||
-- let nameRecipient = abbrvName <$> recipient
|
||||
-- nameSender = abbrvName <$> sender
|
||||
-- nameCourse = CI.original . courseShorthand <$> course
|
||||
|
||||
@ -9,8 +9,8 @@ module Utils.Print.RenewQualification where
|
||||
import Import
|
||||
import Text.Hamlet
|
||||
|
||||
import Data.Char as Char
|
||||
import qualified Data.Text as Text
|
||||
-- import Data.Char as Char
|
||||
-- import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Data.FileEmbed (embedFile)
|
||||
@ -55,7 +55,7 @@ instance MDMail LetterRenewQualificationF where
|
||||
instance MDLetter LetterRenewQualificationF where
|
||||
encrypPDFfor _ = PasswordUnderling
|
||||
getLetterKind _ = PinLetter
|
||||
getLetterEnvelope l = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
||||
getLetterEnvelope _ = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
||||
|
||||
letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||
|
||||
132
templates/letter/fraport_f_expiry.md
Normal file
132
templates/letter/fraport_f_expiry.md
Normal file
@ -0,0 +1,132 @@
|
||||
---
|
||||
### Metadaten, welche hier eingestellt werden:
|
||||
# Absender
|
||||
de-subject: 'Entzug "F" (Vorfeldführerschein)'
|
||||
en-subject: Revocation of apron driving license
|
||||
author: Fraport AG - Fahrerausbildung (AVN-AR)
|
||||
phone: +49 69 690-28467
|
||||
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:
|
||||
date: 11.11.1111
|
||||
expiry: 00.00.0000
|
||||
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 nicht mehr gültig.
|
||||
|
||||
|
||||
$if(supervisor)$
|
||||
**$licenceholder$** 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$
|
||||
|
||||
Email
|
||||
|
||||
: $email$
|
||||
|
||||
$else$
|
||||
Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
|
||||
|
||||
|
||||
$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 alotted time
|
||||
for the renewal of the apron driving licence.
|
||||
|
||||
|
||||
The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid now.
|
||||
|
||||
|
||||
$if(supervisor)$
|
||||
$licenceholder$
|
||||
$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$
|
||||
|
||||
Email
|
||||
|
||||
: $email$
|
||||
|
||||
$else$
|
||||
Please contact you employer to book a course for you.
|
||||
|
||||
|
||||
$endif$
|
||||
|
||||
@ -13,7 +13,7 @@ de-opening: Liebe Fahrberechtigungsinhaber,
|
||||
en-opening: Dear driver,
|
||||
de-closing: |
|
||||
Mit freundlichen Grüßen,
|
||||
Ihre Fahrerausbildung
|
||||
Ihre Fraport Fahrerausbildung
|
||||
en-closing: |
|
||||
With kind regards,
|
||||
Your Fraport Driver Training
|
||||
@ -133,7 +133,7 @@ $if(supervisor)$
|
||||
to regain the apron driving licence.
|
||||
$else$
|
||||
you have to participate in a basic training course again to regain
|
||||
your apron driving licnece.
|
||||
your apron driving licence.
|
||||
$endif$
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user