fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(letter): adapt test letter printing

Browse Source
This commit is contained in:
Steffen Jost 2023-03-21 12:35:30 +00:00
parent 2c3ae0ea83
commit b84a6f2cf9
14 changed files with 133 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -29,6 +29,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
QualificationBlockReason: Entzugsbegründung
LmsUser: Inhaber
LmsURL: Link E-Learning
TableLmsEmail: E‑Mail
TableLmsIdent: LMS Identifikation
TableLmsElearning: E‑Learning

1
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -29,6 +29,7 @@ QualificationUserNoRenewal: Expires without further notification
QualificationUserNone: No registered qualifications for this person.
QualificationBlockReason: Reason for revoking
LmsUser: Licensee
LmsURL: Link E-learning
TableLmsEmail: Email
TableLmsIdent: LMS Identifier
TableLmsPin: E‑learning pin

2
models/lms.model
View File

@ -22,7 +22,7 @@ Qualification
-- across all schools, only one qualification may be a driving licence:
UniqueQualificationAvsLicence avsLicence !force
-- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints!
deriving Generic
deriving Eq Generic
-- TODOs:
-- - Enstehen Kosten, wenn Teilnehmer für KnowHow eingereiht werden, aber nicht am Kurs teilnehmen?

66
src/Handler/Admin/Test.hs
View File

@ -10,7 +10,6 @@ module Handler.Admin.Test
import Import
import Utils.Print
import Utils.Print.Letters
import Handler.Utils
import Jobs
@ -23,10 +22,6 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Text.Pandoc as P
import qualified Text.Pandoc.PDF as P
import qualified Text.Pandoc.Builder as P
-- just to test i18nHamlet
import Text.Hamlet
-- import Handler.Utils.I18n
@ -303,36 +298,31 @@ postAdminTestR = do
getAdminTestPdfR :: Handler TypedContent
getAdminTestPdfR = do
-- uUser <- maybeAuth -- to determine language for test
templates <- liftIO $ do
letter_tp <- P.compileTemplate "" templateRenewal
din5008 <- P.compileTemplate "" templateDIN5008
now <- getCurrentTime
return (now, letter_tp, din5008)
case templates of
(_,Left err,_) -> sendResponseStatus internalServerError500 $ "Markdown template error: \n" <> err
(_,_,Left err) -> sendResponseStatus internalServerError500 $ "LaTeX template error: \n" <> err
(now, Right templ, Right latex) -> do
content <- liftIO . P.runIO $ do
let texopts = []
readeropts = def { P.readerExtensions = P.pandocExtensions }
writeropts1 = def { P.writerTemplate = Just templ }
writeropts2 = def { P.writerTemplate = Just latex }
-- https://github.com/jgm/pandoc/issues/1950
-- using markdown as a template for itself for interpolation:
doc1 <- P.readMarkdown readeropts templateRenewal
doc2 <- P.writeMarkdown writeropts1 doc1
doc3 <- P.readMarkdown readeropts doc2
P.makePDF "lualatex" texopts P.writeLaTeX writeropts2 $
P.setDate (P.text . tshow $ utctDay now) doc3
case content of
Right (Right bs) -> do
liftIO $ LBS.writeFile "/tmp/generated.pdf" bs
mbEncPdf <- encryptPDF "tomatenmarmelade" bs
case mbEncPdf of
Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
Right encPdf -> do
liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict bs) now
Right (Left err) -> sendResponseStatus internalServerError500 $ decodeUtf8 $ LBS.toStrict $ "LaTeX compile error: \n" <> err
Left err -> sendResponseStatus internalServerError500 $ "Pandoc error: \n" <> P.renderError err
usr <- requireAuth -- to determine language and recipient for test
qual <- fromMaybeM
(addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
(runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
now <- liftIO getCurrentTime
let nowaday = utctDay now
letter = LetterRenewQualificationF
{ lmsLogin = LmsIdent "abcdefgh"
, lmsPin = "12345678"
, qualHolderID = usr ^. _entityKey
, qualHolderDN = usr ^. _userDisplayName
, qualHolderSN = usr ^. _userSurname
, qualExpiry = succ nowaday
, qualId = qual ^. _entityKey
, qualName = qual ^. _qualificationName . _CI
, qualShort = qual ^. _qualificationShorthand . _CI
, qualSchool = qual ^. _qualificationSchool
, qualDuration = qual ^. _qualificationValidDuration
}
renderLetter usr letter >>= \case
Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
Right pdf -> do
liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
encryptPDF "tomatenmarmelade" pdf >>= \case
Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
Right encPdf -> do
liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now

182
src/Handler/PrintCenter.hs
View File

@ -18,19 +18,12 @@ import Import
import qualified Data.Set as Set
import qualified Data.Map as Map
-- import qualified Data.Text as T
-- import qualified Data.Text.Lazy as LT
-- import qualified Data.ByteString.Lazy as LBS
import qualified Text.Pandoc as P
import qualified Text.Pandoc.Builder as P
import Database.Persist.Sql (updateWhereCount)
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
import qualified Control.Monad.State.Class as State
import Utils.Print
-- import Data.Aeson (encode)
-- import qualified Data.Text as Text
@ -44,35 +37,6 @@ import qualified Data.Csv as Csv
single :: (k,a) -> Map k a
single = uncurry Map.singleton
data MetaPinRenewal = MetaPinRenewal
{ mppExaminee :: Text
, mppAddress :: StoredMarkup
, mppLogin :: Text
, mppPin :: Text
, mppURL :: Maybe URI
, mppDate :: Day
, mppLang :: Lang
, mppOpening :: Maybe Text
, mppClosing :: Maybe Text
, mppSupervisor:: Maybe Text
}
deriving (Eq, Ord, Show, Generic)
-- TODO: just for testing, remove in production
instance Default MetaPinRenewal where
def = MetaPinRenewal
{ mppExaminee = "Papa Schlumpf"
, mppAddress = plaintextToStoredMarkup ("Erdbeerweg 42\n98726 Schlumpfhausen"::Text)
, mppLogin = "keiner123"
, mppPin = "89998a"
, mppURL = Nothing
, mppDate = fromGregorian 2022 07 27
, mppLang = "de-de"
, mppOpening = Just "Lieber Schlumpfi,"
, mppClosing = Nothing
, mppSupervisor= Nothing
}
data LRQF = LRQF
{ lrqfUser :: Either UserEmail UserId
, lrqfSuper :: Maybe (Either UserEmail UserId)
@ -80,81 +44,50 @@ data LRQF = LRQF
, lrqfIdent :: LmsIdent
, lrqfPin :: Text
, lrqfExpiry:: Day
} deriving (Eq, Ord, Show, Generic)
} deriving (Eq, Generic)
makeRenewalForm :: Maybe LRQF -> Form LRQF
makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do
now_day <- utctDay <$> liftIO getCurrentTime
-- now_day <- utctDay <$> liftIO getCurrentTime
flip (renderAForm FormStandard) html $ LRQF
<$> areq userField (fslI MsgLmsUser) (lrqfUser <$> tmpl)
<*> aopt userField (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 MsgMsgLmsQualificationValidUntil) (lrqfExpiry <$> 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)
where
lmsField = convertField LmsIdent getLmsIdent
lmsField = convertField LmsIdent getLmsIdent textField
validateLetterRenewQualificationF :: FormValidator MetaPinRenewal Handler ()
validateLetterRenewQualificationF :: FormValidator LRQF Handler ()
validateLetterRenewQualificationF = -- do
-- MetaPinRenewal{..} <- State.get
-- LRQF{..} <- State.get
return ()
lrqf2letter :: LRQF -> DB (LetterRenewQualificationF, Entity User)
lrqf2letter :: LRQF -> DB (Entity User, LetterRenewQualificationF)
lrqf2letter LRQF{..} = do
usr <- getUser lrqfUser
rcvr <- getUser <$> lrqfSuper
usr <- getUser lrqfUser
rcvr <- mapM getUser lrqfSuper
let letter = LetterRenewQualificationF
{ lmsLogin = lrqfIdent
, lmsPin = lrqfPin
, qualHolderID = usr ^. _entityKey
, qualHolderDN = usr ^. _userDisplayName
, qualHolderSN = usr ^. _userSurname
, qualExpiry = lrqfExpiry
, qualId = lrqfQuali ^. _entityKey
, qualName = lrqfQuali ^. _qualificationName
, qualShort = lrqfQuali ^. _qualificationShort
, qualSchool = lrqfQuali ^. _qualificationSchool
, qualDuration = lrqfQuali ^. _qualificationValidDuration
}
return (letter, fromMaybe usr rcvr)
{ lmsLogin = lrqfIdent
, lmsPin = lrqfPin
, qualHolderID = usr ^. _entityKey
, qualHolderDN = usr ^. _userDisplayName
, qualHolderSN = usr ^. _userSurname
, qualExpiry = lrqfExpiry
, qualId = lrqfQuali ^. _entityKey
, qualName = lrqfQuali ^. _qualificationName . _CI
, qualShort = lrqfQuali ^. _qualificationShorthand . _CI
, qualSchool = lrqfQuali ^. _qualificationSchool
, qualDuration = lrqfQuali ^. _qualificationValidDuration
}
return (fromMaybe usr rcvr, letter)
where
getUser :: Either UserEmail UserId -> Entity User
getUser :: Either UserEmail UserId -> DB (Entity User)
getUser (Right uid) = getEntity404 uid
getUser (Left mail) = getBy404 $ UniqueEmail mail
mprToMeta :: MetaPinRenewal -> P.Meta
mprToMeta MetaPinRenewal{..} = mkMeta
-- formatTimeUser SelFormatDate mppDate mppExaminee
[ toMeta "examinee" mppExaminee
, toMeta "address" (mppExaminee : (mppAddress & html2textlines))
, toMeta "login" mppLogin
, toMeta "pin" mppPin
, mbMeta "url" (mppURL <&> tshow)
, toMeta "date" (mppDate & tshow) -- rendering according to user preference requires Handler Monad; deferred to Post-processing of P.Meta
, toMeta "lang" mppLang
, mbMeta keyOpening mppOpening
, mbMeta keyClosing mppClosing
, mbMeta "supervisor" mppSupervisor
]
where
deOrEn = if isDe mppLang then "de" else "en"
keyOpening = deOrEn <> "-opening"
keyClosing = deOrEn <> "-closing"
mprToMetaUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity User -> MetaPinRenewal -> m P.Meta
mprToMetaUser entUser@Entity{entityVal = u} mpr = do
let userLang = userLanguages u >>= (listToMaybe . view _Wrapped) -- auch möglich `op Languages` statt `view _Wrapped`
meta = mprToMeta mpr{ mppExaminee = userDisplayName u
-- , mppAddress = userDisplayName u : html2textlines userAddress --TODO once we have User addresses within the DB
, mppLang = fromMaybe (mppLang mpr) userLang -- check if this is the desired behaviour!
}
userDate <- formatTimeUser SelFormatDate (mppDate mpr) (Just entUser)
return $ P.setMeta "date" userDate meta
data PJTableAction = PJActAcknowledge
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
@ -340,40 +273,33 @@ postPrintCenterR = do
getPrintSendR, postPrintSendR :: Handler Html
getPrintSendR = postPrintSendR
postPrintSendR = do
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm $ Just def
let procFormSend mpr = do
receivers <- runDB $ Ex.select $ do
user <- Ex.from $ Ex.table @User
Ex.where_ $ E.val (mppExaminee mpr) `E.isInfixOf` (user E.^. UserIdent)
pure user
letters <- case receivers of
[] -> pure . (Nothing ,) <$> pdfRenewal (mprToMeta mpr)
_ -> forM receivers $ \usr -> do
meta <- mprToMetaUser usr mpr
pdf <- pdfRenewal meta
return (Just $ entityKey usr, pdf)
oks <- forM letters $ \case
(mbRecipient, Right bs) -> do
-- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
-- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
uID <- maybeAuthId
runDB (sendLetter' "Test-Brief" "abcdefgh" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr
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
(Nothing, Left err) -> do
addMessage Error $ toHtml err
usr <- requireAuth -- to determine language and recipient for test
mbQual <- runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand]
now <- liftIO getCurrentTime
let nowaday = utctDay now
mkLetter qual = LRQF
{ lrqfUser = Right $ usr ^. _entityKey
, lrqfSuper = Nothing
, lrqfQuali = qual
, lrqfIdent = LmsIdent "stuvwxyz"
, lrqfPin = "76543210"
, lrqfExpiry = succ nowaday
}
def_lrqf = mkLetter <$> mbQual
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
let procFormSend lrqf = do
ok <- (runDB (lrqf2letter lrqf) >>= printLetter) >>= \case
Left err -> do
let msg = "PDF printing failed with error: " <> err
$logErrorS "LPR" msg
addMessage Error $ toHtml msg
pure False
(Just uid, Left err) -> do
addMessage Error . toHtml $ "For uid " <> tshow uid <> ": " <> err
pure False
when (or oks) $ redirect PrintCenterR
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

4
src/Handler/Users.hs
View File

@ -188,10 +188,10 @@ postUsersR = do
acts = mconcat
[ singletonMap UserLdapSync $ pure UserLdapSyncData
, singletonMap UserAddSupervisor $ UserAddSupervisorData
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
, singletonMap UserSetSupervisor $ UserSetSupervisorData
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
, singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
]

2
src/Utils.hs
View File

@ -275,7 +275,7 @@ addAttrsClass cl attrs = ("class", cl') : noClAttrs
-- tickmark :: IsString a => a
-- tickmark = fromString "✔"
nonBreakableDash :: Text -- used directly in several Messages
nonBreakableDash :: Text -- used directly in several messages
nonBreakableDash = "‑"
-- | Deprecated, replace with Data.Text.elem, once a newer version of Data.Text is available

42
src/Utils/Print.hs
View File

@ -7,6 +7,7 @@
module Utils.Print
( renderLetter -- used for generating letter pdfs
, sendEmailOrLetter -- directly print or sends by email
, printLetter -- always send a letter
, encryptPDF
, sanitizeCmdArg, validCmdArgument
-- , compileTemplate, makePDF
@ -156,20 +157,27 @@ renderLetter rcvrEnt@Entity{entityKey=uid, entityVal=rcvr} mdl = do
---------------
-- Only used in print-test-handler for PrintSendR
sendLetter' :: Text -> Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsIdent -> DB (Either Text (Text, FilePath))
sendLetter' printJobName printJobApcAcknowledge pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser =
sendLetter pdf PrintJobIdentification
{ pjiName = printJobName
, pjiApcAcknowledge = printJobApcAcknowledge
, pjiRecipient = printJobRecipient
, pjiSender = printJobSender
, pjiCourse = printJobCourse
, pjiQualification = printJobQualification
, pjiLmsUser = printJobLmsUser
}
printLetter :: (MDLetter l) => (Entity User, l) -> Handler (Either Text (Text, FilePath))
printLetter (rcvr, letter) = do
pdf <- renderLetter rcvr letter
let protoPji = getPJId letter
pji = protoPji
{ pjiRecipient = Just $ entityKey rcvr
, pjiName = "TEST_" <> pjiName protoPji
}
actRight pdf $ runDB . printLetter' pji
sendLetter :: LBS.ByteString -> PrintJobIdentification -> DB (Either Text (Text, FilePath))
sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiApcAcknowledge = printJobApcAcknowledge, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do
printLetter' :: PrintJobIdentification -> LBS.ByteString -> DB (Either Text (Text, FilePath))
printLetter' pji pdf = do
let PrintJobIdentification
{ pjiName = printJobName
, pjiApcAcknowledge = printJobApcAcknowledge
, pjiRecipient = printJobRecipient
, pjiSender = printJobSender
, pjiCourse = printJobCourse
, pjiQualification = printJobQualification
, pjiLmsUser = printJobLmsUser
} = pji
recipient <- join <$> mapM get printJobRecipient
sender <- join <$> mapM get printJobSender
course <- join <$> mapM get printJobCourse
@ -194,8 +202,8 @@ sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiApcAcknowledge
return $ Right (ok, printJobFilename)
{-
sendLetter'' :: _ -> DB PureFile
sendLetter'' _ = do
printLetter'' :: _ -> DB PureFile
printLetter'' _ = do
...
return $ File { fileTitle = printJobFilename
, fileModified = printJobCreated
@ -226,7 +234,7 @@ sendEmailOrLetter recipient letter = do
$logErrorS "LETTER" msg
return False
Right pdf | preferPost -> -- send printed letter
runDB (sendLetter pdf pjid{ pjiRecipient = Just svr}) >>= \case
runDB (printLetter' pjid{pjiRecipient = Just svr} pdf) >>= \case
Left err -> do
encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
@ -329,7 +337,7 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
-- The cups version of lpr is instead used like so:
-- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
-- | Internal only, use `sendLetter` instead
-- | Internal only, use `printLetter` instead
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Text -> LBS.ByteString -> m (Either Text Text)
lprPDF jb bs = do
mbLprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg

14
src/Utils/Print/Letters.hs
View File

@ -7,7 +7,7 @@
module Utils.Print.Letters where
-- import Import.NoModel
-- import Data.Char (isSeparator)
import Data.Char as Char
import qualified Data.Text as Text
-- import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Fold
@ -173,15 +173,21 @@ data PrintJobIdentification = PrintJobIdentification
-- | create an identifier for printing with apc; which must always be place in the same position for all letters, printed in white on white
-- Note that all letters to the same UUID within 24h are collated in one envelope
mkApcIdent :: CryptoUUIDUser -> Char -> LetterKind -> Text -> P.Meta
mkApcIdent uuid envelope lk apcAck = P.Meta $ toMeta "apc-ident" $ apcSep <> apcIdent <> apcSep
mkApcIdent uuid envelope lk apcAck = P.Meta $ toMeta "apc-ident" apcIdent
where
apcSep = "___"
apcIdent = Text.intercalate apcSep
[ tshow uuid <> Text.cons '-' (Text.singleton envelope)
apcIdent = Text.filter apcAcceptedChars $ Text.intercalate apcSep
[ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope)
, paperKind lk
, apcAck
]
-- | Character allowed to be included in the APC identifier string printed in white in the header of all printed letters
apcAcceptedChars :: Char -> Bool
apcAcceptedChars '-' = True
apcAcceptedChars '_' = True
apcAcceptedChars c = isAlphaNum c
------------------

4
src/Utils/Print/RenewQualification.hs
View File

@ -9,7 +9,7 @@ module Utils.Print.RenewQualification where
import Import
import Text.Hamlet
-- import Data.Char (isSeparator)
import Data.Char as Char
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
@ -48,7 +48,7 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
instance MDLetter LetterRenewQualificationF where
getLetterKind _ = PinLetter
getLetterEnvelope l = maybe 'q' fst $ Text.uncons (qualShort l)
getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =

4
templates/i18n/admin-test/de-de-formal.hamlet
View File

@ -81,10 +81,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<h2>
Erzeugtes PDF herunterladen:
<p>
Hier ist ein
Hier ist ein #
<a href=@{AdminTestPdfR}>
Download-Link
für eine PDF Vorschau.
\ für eine PDF Vorschau.
<p>
Zusätzlich wird dabei im Verzeichnis /tmp
das PDF mit und ohne Passwort gespeichert.

4
templates/i18n/admin-test/en-eu.hamlet
View File

@ -81,10 +81,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<h2>
Download a generated PDF
<p>
Here is a
Here is a #
<a href=@{AdminTestPdfR}>
Download-Link
for a preview.
\ for a preview.
<p>
Following the link, the pdf will also be saved
to the /tmp directory, once without

2
templates/mail/body/qualificationRenewal.hamlet
View File

@ -22,4 +22,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{SomeMessage MsgLmsRenewalInstructions} #
<a href=#{lmsUrlLogin}>
_{SomeMessage MsgMppURL} #{lmsUrl}
_{SomeMessage MsgLmsURL} #{lmsUrl}

6
templates/system-message.hamlet
View File

@ -13,6 +13,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe (messageEditModal, translationAddModal, translationsEditModal) <- forms
<section>
^{messageEditModal}
^{translationAddModal}
^{translationsEditModal}
^{messageEditModal} #
^{translationAddModal} #
^{translationsEditModal} #