refactor(letter): adapt test letter printing

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -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

messages/uniworx/categories/qualification/en-eu.msg

@@ -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

models/lms.model

@@ -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?

src/Handler/Admin/Test.hs

@@ -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
+  usr  <- requireAuth -- to determine language and recipient for test 
-  templates <- liftIO $ do
+  qual <- fromMaybeM
-    letter_tp <- P.compileTemplate "" templateRenewal
+            (addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
-    din5008   <- P.compileTemplate "" templateDIN5008
+            (runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
-    now       <- getCurrentTime
+  now <- liftIO getCurrentTime
-    return (now, letter_tp, din5008)
+  let nowaday = utctDay now
-  case templates of
+      letter  = LetterRenewQualificationF
-    (_,Left err,_) -> sendResponseStatus internalServerError500 $ "Markdown template error: \n" <> err
+        { lmsLogin      = LmsIdent "abcdefgh"
-    (_,_,Left err) -> sendResponseStatus internalServerError500 $ "LaTeX template error: \n"    <> err
+        , lmsPin        = "12345678"
-    (now, Right templ, Right latex) -> do
+        , qualHolderID  = usr ^. _entityKey
-      content <- liftIO . P.runIO $ do
+        , qualHolderDN  = usr ^. _userDisplayName
-        let texopts = []
+        , qualHolderSN  = usr ^. _userSurname
-            readeropts  = def { P.readerExtensions = P.pandocExtensions }
+        , qualExpiry    = succ nowaday
-            writeropts1 = def { P.writerTemplate = Just templ }
+        , qualId        = qual ^. _entityKey
-            writeropts2 = def { P.writerTemplate = Just latex }
+        , qualName      = qual ^. _qualificationName      . _CI
-          -- https://github.com/jgm/pandoc/issues/1950
+        , qualShort     = qual ^. _qualificationShorthand . _CI
-          -- using markdown as a template for itself for interpolation:
+        , qualSchool    = qual ^. _qualificationSchool
-        doc1 <- P.readMarkdown  readeropts  templateRenewal
+        , qualDuration  = qual ^. _qualificationValidDuration
-        doc2 <- P.writeMarkdown writeropts1 doc1
+        }
-        doc3 <- P.readMarkdown  readeropts  doc2
+  renderLetter usr letter >>= \case
-        P.makePDF "lualatex" texopts P.writeLaTeX writeropts2 $
+    Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
-          P.setDate (P.text . tshow $ utctDay now) doc3
+    Right pdf -> do
-      case content of
+      liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
-        Right (Right bs) -> do
+      encryptPDF "tomatenmarmelade" pdf >>= \case
-          liftIO $ LBS.writeFile "/tmp/generated.pdf" bs
+        Left err      -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
-          mbEncPdf <- encryptPDF "tomatenmarmelade" bs
+        Right encPdf  -> do 
-          case mbEncPdf of 
+          liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
-            Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
+          sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now
-            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

src/Handler/PrintCenter.hs

@@ -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)
+    <$> areq (userField False Nothing)  (fslI MsgLmsUser)                      (lrqfUser   <$> tmpl)
-    <*> aopt userField              (fslI MsgTableSupervisor)                 (lrqfSuper  <$> tmpl)
+    <*> aopt (userField False Nothing)  (fslI MsgTableSupervisor)              (lrqfSuper  <$> tmpl)
-    <*> areq qualificationFieldEnt  (fslI MsgQualificationName)               (lrqfQuali  <$> tmpl)
+    <*> areq qualificationFieldEnt      (fslI MsgQualificationName)            (lrqfQuali  <$> tmpl)
-    <$> areq lmsField               (fslI MsgTableLmsIdent)                   (lrqfIdent  <$> tmpl) 
+    <*> areq lmsField                   (fslI MsgTableLmsIdent)                (lrqfIdent  <$> tmpl) 
-    <*> areq textField              (fslI MsgTableLmsPin)                     (lrqfPin    <$> tmpl)
+    <*> areq textField                  (fslI MsgTableLmsPin)                  (lrqfPin    <$> tmpl)
-    <*> areq dayField               (fslI MsgMsgLmsQualificationValidUntil)   (lrqfExpiry <$> 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
+    usr   <-      getUser lrqfUser
-    rcvr  <- getUser <$> lrqfSuper
+    rcvr  <- mapM getUser lrqfSuper
     let letter = LetterRenewQualificationF 
-      { lmsLogin      = lrqfIdent
+          { lmsLogin      = lrqfIdent
-      , lmsPin        = lrqfPin
+          , lmsPin        = lrqfPin
-      , qualHolderID  = usr ^. _entityKey
+          , qualHolderID  = usr ^. _entityKey
-      , qualHolderDN  = usr ^. _userDisplayName
+          , qualHolderDN  = usr ^. _userDisplayName
-      , qualHolderSN  = usr ^. _userSurname
+          , qualHolderSN  = usr ^. _userSurname
-      , qualExpiry    = lrqfExpiry
+          , qualExpiry    = lrqfExpiry
-      , qualId        = lrqfQuali ^. _entityKey
+          , qualId        = lrqfQuali ^. _entityKey
-      , qualName      = lrqfQuali ^. _qualificationName
+          , qualName      = lrqfQuali ^. _qualificationName      . _CI
-      , qualShort     = lrqfQuali ^. _qualificationShort
+          , qualShort     = lrqfQuali ^. _qualificationShorthand . _CI
-      , qualSchool    = lrqfQuali ^. _qualificationSchool
+          , qualSchool    = lrqfQuali ^. _qualificationSchool
-      , qualDuration  = lrqfQuali ^. _qualificationValidDuration
+          , qualDuration  = lrqfQuali ^. _qualificationValidDuration
-      }
+          }
-    return (letter, fromMaybe usr rcvr)
+    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
+  usr  <- requireAuth -- to determine language and recipient for test 
-  let procFormSend mpr = do
+  mbQual <- runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand]
-        receivers <- runDB $ Ex.select $ do
+  now <- liftIO getCurrentTime
-          user <- Ex.from $ Ex.table @User
+  let nowaday = utctDay now
-          Ex.where_ $ E.val (mppExaminee mpr) `E.isInfixOf` (user E.^. UserIdent)
+      mkLetter qual = LRQF
-          pure user
+        { lrqfUser      = Right $ usr ^. _entityKey
-        letters <- case receivers of
+        , lrqfSuper     = Nothing
-          [] -> pure . (Nothing ,) <$> pdfRenewal (mprToMeta mpr)
+        , lrqfQuali     = qual
-          _  -> forM receivers $ \usr -> do
+        , lrqfIdent     = LmsIdent  "stuvwxyz"
-                  meta <- mprToMetaUser usr mpr
+        , lrqfPin       =           "76543210"
-                  pdf <- pdfRenewal meta
+        , lrqfExpiry    = succ nowaday
-                  return (Just $ entityKey usr, pdf)
+        }
-        oks <- forM letters $ \case
+      def_lrqf = mkLetter <$> mbQual
-          (mbRecipient, Right bs) -> do
+
-            -- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
+  ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
-            -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
+  let procFormSend lrqf = do
-            uID <- maybeAuthId
+        ok <- (runDB (lrqf2letter lrqf) >>= printLetter) >>= \case 
-            runDB (sendLetter' "Test-Brief" "abcdefgh" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr
+          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
+            addMessage Error $ toHtml 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
             pure False
-          (Just uid, Left err) -> do
+          Right (ok, fpath) -> do
-            addMessage Error . toHtml $ "For uid " <> tshow uid <> ": " <> err
+            let response = if null ok then mempty else  " Response: " <> ok
-            pure False
+            addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
-        when (or oks) $ redirect PrintCenterR
+            pure True
+        when ok $ redirect PrintCenterR
   formResult sendResult procFormSend
   -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
   siteLayoutMsg MsgPrintManualRenewal $ do

src/Handler/Users.hs

@@ -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
         ]

src/Utils.hs

@@ -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

src/Utils/Print.hs

@@ -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))
+printLetter :: (MDLetter l) => (Entity User, l) -> Handler (Either Text (Text, FilePath))
-sendLetter' printJobName printJobApcAcknowledge pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser =
+printLetter (rcvr, letter) = do 
-  sendLetter pdf PrintJobIdentification
+  pdf <- renderLetter rcvr letter
-    { pjiName = printJobName
+  let protoPji = getPJId letter 
-    , pjiApcAcknowledge = printJobApcAcknowledge
+      pji = protoPji 
-    , pjiRecipient = printJobRecipient
+              { pjiRecipient = Just $ entityKey rcvr
-    , pjiSender = printJobSender
+              , pjiName = "TEST_" <> pjiName protoPji
-    , pjiCourse = printJobCourse
+              }
-    , pjiQualification = printJobQualification
+  actRight pdf $ runDB . printLetter' pji
-    , pjiLmsUser = printJobLmsUser
-    }
 
-sendLetter :: LBS.ByteString -> PrintJobIdentification -> DB (Either Text (Text, FilePath))
+printLetter' :: PrintJobIdentification -> LBS.ByteString -> DB (Either Text (Text, FilePath))
-sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiApcAcknowledge = printJobApcAcknowledge, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do
+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
+printLetter'' :: _ -> DB PureFile
-sendLetter'' _ = do
+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

src/Utils/Print/Letters.hs

@@ -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
+    apcIdent = Text.filter apcAcceptedChars $ Text.intercalate apcSep
-      [ tshow uuid <> Text.cons '-' (Text.singleton envelope)
+      [ 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
+
 
 
 ------------------

src/Utils/Print/RenewQualification.hs

@@ -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 } = 

templates/i18n/admin-test/de-de-formal.hamlet

@@ -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.

templates/i18n/admin-test/en-eu.hamlet

@@ -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

templates/mail/body/qualificationRenewal.hamlet

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

templates/system-message.hamlet

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