Merge branch 'fradrive/localmaster'

This commit is contained in:
Steffen Jost 2023-05-08 17:59:31 +00:00
commit f311a3d319
8 changed files with 44 additions and 28 deletions

View File

@ -2,7 +2,7 @@
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE TypeApplications, ExistentialQuantification #-} {-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Handler.PrintCenter module Handler.PrintCenter
@ -25,7 +25,6 @@ import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH import Database.Esqueleto.Utils.TH
import Utils.Print import Utils.Print
import Utils.Print.Letters (MDLetter)
-- import Data.Aeson (encode) -- import Data.Aeson (encode)
import qualified Data.Text as Text import qualified Data.Text as Text
@ -39,7 +38,6 @@ import Handler.Utils
single :: (k,a) -> Map k a single :: (k,a) -> Map k a
single = uncurry Map.singleton 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 data LRQF = LRQF
{ lrqfLetter :: Text { lrqfLetter :: Text
@ -313,9 +311,7 @@ postPrintSendR = do
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
let procFormSend lrqf = do let procFormSend lrqf = do
ok <- (runDB (lrqf2letter lrqf) >>= \case ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
(entUsr, SomeLetter l) -> printLetter (Just uid) (entUsr, l)
) >>= \case
Left err -> do Left err -> do
let msg = "PDF printing failed with error: " <> err let msg = "PDF printing failed with error: " <> err
$logErrorS "LPR" msg $logErrorS "LPR" msg

View File

@ -19,6 +19,7 @@ module Utils.Print
, mkMeta, appMeta, applyMetas -- multiple values , mkMeta, appMeta, applyMetas -- multiple values
-- , MDMail -- , MDMail
-- , MDLetter -- , MDLetter
, SomeLetter(..)
, LetterRenewQualificationF(..) , LetterRenewQualificationF(..)
, LetterExpireQualificationF(..) , LetterExpireQualificationF(..)
-- , LetterCourseCertificate() -- , LetterCourseCertificate()
@ -55,6 +56,7 @@ import Jobs.Handler.SendNotification.Utils
import Utils.Print.Instances () import Utils.Print.Instances ()
import Utils.Print.Letters import Utils.Print.Letters
import Utils.Print.SomeLetter
import Utils.Print.RenewQualification import Utils.Print.RenewQualification
import Utils.Print.ExpireQualification import Utils.Print.ExpireQualification
import Utils.Print.CourseCertificate import Utils.Print.CourseCertificate
@ -148,7 +150,7 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind $ pure mdl kind = getLetterKind mdl
tmpl = getTemplate mdl tmpl = getTemplate mdl
meta = addApcIdent apcIdent meta = addApcIdent apcIdent
<> letterMeta mdl formatter lang rcvrEnt <> letterMeta mdl formatter lang rcvrEnt
@ -170,7 +172,7 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind $ pure l kind = getLetterKind l
templateCombine _ err@Left{} = pure err templateCombine _ err@Left{} = pure err
templateCombine mdl (Right doc1) = templateCombine mdl (Right doc1) =
@ -286,7 +288,7 @@ sendEmailOrLetter recipient letter = do
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
return True return True
Right pdf -> do -- send email Right pdf -> do -- send email
let pdfPass = case encrypPDFfor (pure letter) of let pdfPass = case encryptPDFfor letter of
NoPassword -> Nothing NoPassword -> Nothing
PasswordSupervisor -> rcvrUsr ^. _userPinPassword PasswordSupervisor -> rcvrUsr ^. _userPinPassword
PasswordUnderling -> underling ^. _userPinPassword PasswordUnderling -> underling ^. _userPinPassword

View File

@ -36,7 +36,7 @@ data LetterCourseCertificate = LetterCourseCertificate
instance MDLetter LetterCourseCertificate where instance MDLetter LetterCourseCertificate where
encrypPDFfor _ = NoPassword encryptPDFfor _ = NoPassword
getLetterKind _ = Plain getLetterKind _ = Plain
getLetterEnvelope _ = 'c' getLetterEnvelope _ = 'c'
getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} = getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} =

View File

@ -48,7 +48,7 @@ instance MDMail LetterExpireQualificationF where
in $(ihamletFile "templates/mail/qualificationExpired.hamlet") in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
instance MDLetter LetterExpireQualificationF where instance MDLetter LetterExpireQualificationF where
encrypPDFfor _ = NoPassword encryptPDFfor _ = NoPassword
getLetterKind _ = Din5008 getLetterKind _ = Din5008
getLetterEnvelope _ = 'e' getLetterEnvelope _ = 'e'
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md") getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")

View File

@ -154,18 +154,10 @@ paperKind PlainLogo = "a4log"
--------------- ---------------
-- PrintJobs -- -- PrintJobs --
--------------- ---------------
apcIdentSeparator :: Text
apcIdentSeparator = Text.take 3 "___" -- must always have length 3
data PrintJobIdentification = PrintJobIdentification data PrintJobIdentification = PrintJobIdentification
{ pjiName :: Text { pjiName :: Text
, pjiApcAcknowledge :: Text , pjiApcAcknowledge :: Text
@ -187,12 +179,15 @@ mkApcIdent uuid envelope lk tnow apcAck = Text.filter apcAcceptedChars $ Text.in
[ ensureLength 38 $ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope) [ ensureLength 38 $ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope)
, ensureLength 5 $ paperKind lk , ensureLength 5 $ paperKind lk
, ensureLength 9 tnow , ensureLength 9 tnow
, apcAck -- length may be arbitrary, thus far was always 12 , apcAck -- length of last part may be arbitrary, thus far was always 12
] ]
where where
ensureLength :: Int -> Text -> Text ensureLength :: Int -> Text -> Text
ensureLength n = Text.take n . Text.justifyLeft n 'x' ensureLength n = Text.take n . Text.justifyLeft n 'x'
apcIdentSeparator :: Text
apcIdentSeparator = Text.take 3 "___" -- must always have length 3
-- | Character allowed to be included in the APC identifier string printed in white in the header of all printed letters, must not contain ',' nor ';' -- | Character allowed to be included in the APC identifier string printed in white in the header of all printed letters, must not contain ',' nor ';'
apcAcceptedChars :: Char -> Bool apcAcceptedChars :: Char -> Bool
apcAcceptedChars '-' = True apcAcceptedChars '-' = True
@ -225,15 +220,15 @@ class MDLetter l where
-- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver -- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver
getPJId :: l -> PrintJobIdentification getPJId :: l -> PrintJobIdentification
getLetterEnvelope :: l -> Char getLetterEnvelope :: l -> Char
getLetterKind :: Proxy l -> LetterKind getLetterKind :: l -> LetterKind
getTemplate :: l -> Text getTemplate :: l -> Text
encrypPDFfor :: Proxy l -> EncryptPDFfor encryptPDFfor :: l -> EncryptPDFfor
letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
letterApcIdent l uuid now = do letterApcIdent l uuid now = do
-- now <- liftIO getCurrentTime -- now <- liftIO getCurrentTime
tnow <- formatTime' "%y%m%d-%H" now tnow <- formatTime' "%y%m%d-%H" now
return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind $ pure l) tnow (pjiApcAcknowledge $ getPJId l) return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l)
letterFileName :: (MDLetter l) => l -> FilePath letterFileName :: (MDLetter l) => l -> FilePath
letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId

View File

@ -53,7 +53,7 @@ instance MDMail LetterRenewQualificationF where
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet") in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
instance MDLetter LetterRenewQualificationF where instance MDLetter LetterRenewQualificationF where
encrypPDFfor _ = PasswordUnderling encryptPDFfor _ = PasswordUnderling
getLetterKind _ = PinLetter getLetterKind _ = PinLetter
getLetterEnvelope _ = '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") getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")

View File

@ -0,0 +1,23 @@
-- SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE ExistentialQuantification #-}
module Utils.Print.SomeLetter where
import Utils.Print.Letters
data SomeLetter = forall l . (MDLetter l, MDMail l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
instance MDMail SomeLetter where
getMailSubject (SomeLetter l) = getMailSubject l
getMailBody (SomeLetter l) = getMailBody l
instance MDLetter SomeLetter where
letterMeta (SomeLetter l) = letterMeta l
getPJId (SomeLetter l) = getPJId l
getLetterEnvelope (SomeLetter l) = getLetterEnvelope l
getLetterKind (SomeLetter l) = getLetterKind l
getTemplate (SomeLetter l) = getTemplate l
encryptPDFfor (SomeLetter l) = encryptPDFfor l

View File

@ -50,7 +50,7 @@ $if(is-de)$
<!-- deutsche Version des Briefes --> <!-- deutsche Version des Briefes -->
$if(supervisor)$ $if(supervisor)$
leider hat $licenceholder$ leider hat **$licenceholder$**
$else$ $else$
leider haben Sie leider haben Sie
$endif$ $endif$
@ -62,7 +62,7 @@ Die Qualifikation „Vorfeldführerschein“ ist somit nicht mehr gültig.
$if(supervisor)$ $if(supervisor)$
**$licenceholder$** darf $licenceholder$ darf
$else$ $else$
Sie dürfen Sie dürfen
$endif$ $endif$
@ -94,7 +94,7 @@ $if(supervisor)$
$else$ $else$
you you
$endif$ $endif$
did not pass the required knowledge test within the alotted time did not pass the required knowledge test within the allotted time
for the renewal of the apron driving licence. for the renewal of the apron driving licence.
@ -124,7 +124,7 @@ Email
: $email$ : $email$
$else$ $else$
Please contact you employer to book a course for you. Please contact your employer to book a course for you.
$endif$ $endif$
$endif$ $endif$