diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 4a1911e5a..c06b156d1 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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 diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 4e1f9954f..5cd1a7e4f 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -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 diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index c7c22f484..7bd3fd9c8 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -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 diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 939f6c97b..7327d651b 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -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}} = diff --git a/templates/letter/fraport_f_expiry.md b/templates/letter/fraport_f_expiry.md new file mode 100644 index 000000000..63276074f --- /dev/null +++ b/templates/letter/fraport_f_expiry.md @@ -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)$ + + +$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$ + + +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$ + diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 17745bf5d..d7707d78a 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -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$