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

chore(print): rework templating and apc acknowledge id mechanism

Browse Source
This commit is contained in:
Steffen Jost 2023-03-16 17:53:16 +00:00
parent d2020866a8
commit bb9c2259e9
11 changed files with 169 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,6 +7,7 @@ PrintJobName: Bezeichnung
PrintJobFilename: Dateiname PrintJobFilename: Dateiname
PrintJobId !ident-ok: Id PrintJobId !ident-ok: Id
PrintJobCreated: Gesendet PrintJobCreated: Gesendet
PrintJobApcAcknowledge: Bestätigungs ID
PrintJobAcknowledged: Bestätigt PrintJobAcknowledged: Bestätigt
PrintJobUnacknowledged: Noch nicht gedruckt PrintJobUnacknowledged: Noch nicht gedruckt
PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt

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

@ -7,6 +7,7 @@ PrintJobName: Description
PrintJobFilename: Filename PrintJobFilename: Filename
PrintJobId: Id PrintJobId: Id
PrintJobCreated: Created PrintJobCreated: Created
PrintJobApcAcknowledge: Acknowledge ID
PrintJobAcknowledged: Acknowledged PrintJobAcknowledged: Acknowledged
PrintJobUnacknowledged: Not yet printed PrintJobUnacknowledged: Not yet printed
PrintJobAcknowledge n: #{n} #{pluralENs n "print-job"} marked as printed and mailed PrintJobAcknowledge n: #{n} #{pluralENs n "print-job"} marked as printed and mailed

22
models/print.model
View File

@ -3,15 +3,17 @@
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
PrintJob PrintJob
name Text name Text
filename FilePath apcAcknowledge Text default='unknown'
file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe filename FilePath
created UTCTime file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe
acknowledged UTCTime Maybe created UTCTime
recipient UserId Maybe OnDeleteCascade OnUpdateCascade -- optional as some letters may contain just an address acknowledged UTCTime Maybe
sender UserId Maybe OnDeleteSetNull OnUpdateCascade -- senders and associations are optional recipient UserId Maybe OnDeleteCascade OnUpdateCascade -- optional as some letters may contain just an address
course CourseId Maybe OnDeleteCascade OnUpdateCascade sender UserId Maybe OnDeleteSetNull OnUpdateCascade -- senders and associations are optional
qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade course CourseId Maybe OnDeleteCascade OnUpdateCascade
lmsUser LmsIdent Maybe OnDeleteCascade OnUpdateCascade -- allows tracking if recipient has been notified; must be unique qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade
lmsUser LmsIdent Maybe OnDeleteCascade OnUpdateCascade -- allows tracking if recipient has been notified; must be unique
-- UniquePrintJobLmsUser lmsUser -- Note that in fact multiple print jobs per LMS user are possible! -- UniquePrintJobLmsUser lmsUser -- Note that in fact multiple print jobs per LMS user are possible!
-- UniquePrintJobApcAcknowledge apcAcknowledge -- TODO: not yet enforced, since LmsIdent is currently used
deriving Generic deriving Generic

13
src/Handler/PrintCenter.hs
View File

@ -201,11 +201,12 @@ mkPJTable = do
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat dbtColonnade = mconcat
[ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged) [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
, sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t , sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
, sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t , sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
, sortable (Just "filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey , sortable (Just "filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey
t = r ^. resultPrintJob . _entityVal . _printJobFilename t = r ^. resultPrintJob . _entityVal . _printJobFilename
in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t) in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t)
, sortable (Just "apcid") (i18nCell MsgPrintJobApcAcknowledge)$ \( view $ resultPrintJob . _entityVal . _printJobApcAcknowledge -> t) -> textCell t
, sortable (Just "name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n , sortable (Just "name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
, sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
, sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
@ -218,6 +219,7 @@ mkPJTable = do
, single ("filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) , single ("filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename))
, single ("created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) , single ("created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
, single ("acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) , single ("acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
, single ("apcid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobApcAcknowledge))
, single ("recipient" , sortUserNameBareM queryRecipient) , single ("recipient" , sortUserNameBareM queryRecipient)
, single ("sender" , sortUserNameBareM querySender ) , single ("sender" , sortUserNameBareM querySender )
, single ("course" , SortColumn $ queryCourse >>> (E.?. CourseName)) , single ("course" , SortColumn $ queryCourse >>> (E.?. CourseName))
@ -226,7 +228,8 @@ mkPJTable = do
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single ("name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) [ single ("name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename)) , single ("apcid" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobApcAcknowledge))
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) , single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) --, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
, single ("recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName)) , single ("recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName))
@ -234,6 +237,7 @@ mkPJTable = do
, single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName)) , single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
, single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName)) , single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
, single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser)) , single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged))) , single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
@ -248,6 +252,7 @@ mkPJTable = do
, prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) , prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)
, prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification) , prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification)
, prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser) , prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser)
, prismAForm (singletonFilter "apcid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobApcAcknowledge)
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged) , prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout} dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
@ -321,7 +326,7 @@ postPrintSendR = do
-- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY -- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
-- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf" -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
uID <- maybeAuthId uID <- maybeAuthId
runDB (sendLetter' "Test-Brief" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr 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

35
src/Utils/Print.hs
View File

@ -203,17 +203,17 @@ pdfLetter md meta = do
return $ over _Left P.renderError result return $ over _Left P.renderError result
renderLetter :: (MDLetter l) => User -> l -> Handler (Either Text LBS.ByteString) renderLetter :: (MDLetter l) => Entity User -> l -> Handler (Either Text LBS.ByteString)
renderLetter rcvr mdl = do renderLetter Entity{entityKey=uid, entityVal=rcvr} mdl = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
uuid :: CryptoUUIDUser <- encrypt uid
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
tmpl = getTemplate $ pure mdl tmpl = getTemplate $ pure mdl
meta = letterMeta mdl formatter lang meta = letterApcIdent uuid mdl
<> letterMeta mdl formatter lang
<> mkMeta <> mkMeta
[ toMeta "paper" ("TODO"::Text) -- TODO continue here [ toMeta "lang" lang
, toMeta "printid" ("TODO"::Text)
, toMeta "lang" lang
, toMeta "date" $ format SelFormatDate now , toMeta "date" $ format SelFormatDate now
, toMeta "rcvr-name" $ rcvr & userDisplayName , toMeta "rcvr-name" $ rcvr & userDisplayName
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr , toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
@ -221,16 +221,18 @@ renderLetter rcvr mdl = do
] ]
pdfLetter tmpl meta pdfLetter tmpl meta
--------------- ---------------
-- PrintJobs -- -- PrintJobs --
--------------- ---------------
-- Only used in print-test-handler for PrintSendR -- Only used in print-test-handler for PrintSendR
sendLetter' :: Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsIdent -> DB (Either Text (Text, FilePath)) sendLetter' :: Text -> Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsIdent -> DB (Either Text (Text, FilePath))
sendLetter' printJobName pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser = sendLetter' printJobName printJobApcAcknowledge pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser =
sendLetter pdf PrintJobIdentification sendLetter pdf PrintJobIdentification
{ pjiName = printJobName { pjiName = printJobName
, pjiApcAcknowledge = printJobApcAcknowledge
, pjiRecipient = printJobRecipient , pjiRecipient = printJobRecipient
, pjiSender = printJobSender , pjiSender = printJobSender
, pjiCourse = printJobCourse , pjiCourse = printJobCourse
@ -239,7 +241,7 @@ sendLetter' printJobName pdf (printJobRecipient, printJobSender) printJobCourse
} }
sendLetter :: LBS.ByteString -> PrintJobIdentification -> DB (Either Text (Text, FilePath)) sendLetter :: LBS.ByteString -> PrintJobIdentification -> DB (Either Text (Text, FilePath))
sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiApcAcknowledge = printJobApcAcknowledge, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do
recipient <- join <$> mapM get printJobRecipient recipient <- join <$> mapM get printJobRecipient
sender <- join <$> mapM get printJobSender sender <- join <$> mapM get printJobSender
course <- join <$> mapM get printJobCourse course <- join <$> mapM get printJobCourse
@ -285,6 +287,7 @@ sendEmailOrLetter recipient letter = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
oks <- forM receivers $ \Entity{ entityKey = svr, entityVal = rcvrUsr } -> do oks <- forM receivers $ \Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr
encRecipient :: CryptoUUIDUser <- encrypt svr
let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
isSupervised = recipient /= svr isSupervised = recipient /= svr
lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang
@ -305,20 +308,17 @@ sendEmailOrLetter recipient letter = do
) )
pdfLetter tmpl lMeta >>= \case pdfLetter tmpl lMeta >>= \case
_ | preferPost, isNothing postal -> do -- neither email nor postal is known _ | preferPost, isNothing postal -> do -- neither email nor postal is known
encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
Left err -> do -- pdf generation failed Left err -> do -- pdf generation failed
encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
Right pdf | preferPost -> -- send printed letter Right pdf | preferPost -> -- send printed letter
runDB (sendLetter pdf pjid{ pjiRecipient = Just svr}) >>= \case runDB (sendLetter pdf pjid{ pjiRecipient = Just svr}) >>= \case
Left err -> do 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 let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
@ -332,8 +332,7 @@ sendEmailOrLetter recipient letter = do
Nothing -> return pdf Nothing -> return pdf
Just passwd -> encryptPDF passwd pdf >>= \case Just passwd -> encryptPDF passwd pdf >>= \case
Right encPdf -> return encPdf Right encPdf -> return encPdf
Left err -> do Left err -> do
encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
$logWarnS "LETTER" msg $logWarnS "LETTER" msg
return pdf return pdf

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

@ -8,7 +8,7 @@ module Utils.Print.Letters where
-- import Import.NoModel -- import Import.NoModel
-- import Data.Char (isSeparator) -- import Data.Char (isSeparator)
-- import qualified Data.Text as T import qualified Data.Text as Text
-- import qualified Data.CaseInsensitive as CI -- import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Fold import qualified Data.Foldable as Fold
@ -37,81 +37,6 @@ import Text.Hamlet
-------------------------
-- Hardcoded Templates --
-------------------------
data LetterKind = Din5008 -- scrlttr2: Standard postal letter with address field, expects peprinted FraportLogo
| PinLetter -- Like Din5008, but for special paper with a protected pin field
| Plain -- scrartcl: Empty, expects empty paper with no preprints
| PlainLogo -- Like plain, but expects to be printed on paper with Logo
-- | Logo -- Like plain, but prints Fraport Logo in the upper right corner
deriving (Eq, Show)
templateLatex :: LetterKind -> Text
templateLatex =
let
tDin5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
tPinLetter = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008with_pin.latex")
tPlain = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/plain_article.latex")
in \case
PinLetter -> tPinLetter
Din5008 -> tDin5008
PlainLogo -> tPlain
Plain -> tPlain
-- | DEPRECATED TODO: remove
templateDIN5008 :: Text
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
templateRenewal :: Text
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
---------------
-- PrintJobs --
---------------
data PrintJobIdentification = PrintJobIdentification
{ pjiName :: Text
, pjiRecipient :: Maybe UserId
, pjiSender :: Maybe UserId
, pjiCourse :: Maybe CourseId
, pjiQualification :: Maybe QualificationId
, pjiLmsUser :: Maybe LmsIdent
}
deriving (Eq, Show)
------------------
-- Letter Class --
------------------
{- Probably not needed:}
data SomeUserTime where
SomeUserTime :: HasLocalTime t => SelDateTimeFormat -> t -> SomeUserTime
data ProtoMeta = IsMeta P.MetaValue
| IsTime SomeUserTime
convertProto :: DateTimeFormatter -> ProtoMeta -> P.MetaValue
convertProto _ (IsMeta v) = v
convertProto f (IsTime t) = P.toMetaValue $ f t
-}
class MDLetter l where
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
letterMeta :: l -> DateTimeFormatter -> Lang -> P.Meta
getTemplate :: Proxy l -> Text
getPJId :: l -> PrintJobIdentification
---------------------- ----------------------
-- Pandoc Functions -- -- Pandoc Functions --
---------------------- ----------------------
@ -193,3 +118,99 @@ defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComm
defWriterOpts :: P.Template Text -> P.WriterOptions defWriterOpts :: P.Template Text -> P.WriterOptions
defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t } defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t }
-------------------------
-- Hardcoded Templates --
-------------------------
data LetterKind = Din5008 -- scrlttr2: Standard postal letter with address field, expects peprinted FraportLogo
| PinLetter -- Like Din5008, but for special paper with a protected pin field
| Plain -- scrartcl: Empty, expects empty paper with no preprints
| PlainLogo -- Like plain, but expects to be printed on paper with Logo
-- | Logo -- Like plain, but prints Fraport Logo in the upper right corner
deriving (Eq, Show)
templateLatex :: LetterKind -> Text
templateLatex =
let
tDin5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
tPinLetter = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008with_pin.latex")
tPlain = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/plain_article.latex")
in \case
PinLetter -> tPinLetter
Din5008 -> tDin5008
PlainLogo -> tPlain
Plain -> tPlain
paperKind :: LetterKind -> Text
paperKind Din5008 = "a4logo"
paperKind PinLetter = "a4pin"
paperKind Plain = "a4plain"
paperKind PlainLogo = "a4logo"
-- | DEPRECATED TODO: remove
templateDIN5008 :: Text
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
templateRenewal :: Text
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
---------------
-- PrintJobs --
---------------
data PrintJobIdentification = PrintJobIdentification
{ pjiName :: Text
, pjiApcAcknowledge :: Text
, pjiRecipient :: Maybe UserId
, pjiSender :: Maybe UserId
, pjiCourse :: Maybe CourseId
, pjiQualification :: Maybe QualificationId
, pjiLmsUser :: Maybe LmsIdent
}
deriving (Eq, Show)
-- | 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 -> LetterKind -> Text -> P.Meta
mkApcIdent uuid lk apcAck = P.Meta $ toMeta "apc-ident" $ apcSep <> apcIdent <> apcSep
where
apcSep = "___"
apcIdent = Text.intercalate apcSep
[ tshow uuid
, paperKind lk
, apcAck
]
------------------
-- Letter Class --
------------------
{- Probably not needed:}
data SomeUserTime where
SomeUserTime :: HasLocalTime t => SelDateTimeFormat -> t -> SomeUserTime
data ProtoMeta = IsMeta P.MetaValue
| IsTime SomeUserTime
convertProto :: DateTimeFormatter -> ProtoMeta -> P.MetaValue
convertProto _ (IsMeta v) = v
convertProto f (IsTime t) = P.toMetaValue $ f t
-}
class MDLetter l where
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
letterMeta :: l -> DateTimeFormatter -> Lang -> P.Meta
getTemplate :: Proxy l -> Text
getLetterKind :: Proxy l -> LetterKind
getPJId :: l -> PrintJobIdentification
letterApcIdent :: MDLetter l => CryptoUUIDUser -> l -> P.Meta
letterApcIdent uuid l = mkApcIdent uuid (getLetterKind $ pure l) (pjiApcAcknowledge $ getPJId l)

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

@ -45,6 +45,7 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
instance MDLetter LetterRenewQualificationF where instance MDLetter LetterRenewQualificationF where
getTemplate _ = templateRenewal getTemplate _ = templateRenewal
getLetterKind _ = PinLetter
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
-- getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l -- getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
@ -66,6 +67,7 @@ instance MDLetter LetterRenewQualificationF where
getPJId LetterRenewQualificationF{..} = getPJId LetterRenewQualificationF{..} =
PrintJobIdentification PrintJobIdentification
{ pjiName = "Renewal" { pjiName = "Renewal"
, pjiApcAcknowledge = "lms" <> getLmsIdent lmsLogin
, pjiRecipient = Nothing -- to be filled later , pjiRecipient = Nothing -- to be filled later
, pjiSender = Nothing , pjiSender = Nothing
, pjiCourse = Nothing , pjiCourse = Nothing

12
templates/letter/din5008.latex
View File

@ -141,15 +141,17 @@ $endif$
$endfor$ $endfor$
} }
$if(apc-ident)$
\begin{textblock}{200}(5,5)%hpos,vpos
\textcolor{white!0}{$apc-ident$}%
\end{textblock}%
$endif$
$if(is-de)$ $if(is-de)$
\opening{$de-opening$} \opening{$de-opening$}
$else$ $else$
\opening{$en-opening$} \opening{$en-opening$}
$endif$ $endif$
\begin{textblock}{65}(142,21)%hpos,vpos
\textcolor{white!0}{\_\_\_$paper$\_\_\_$printid$\_\_\_}%
\end{textblock}
$body$ $body$

13
templates/letter/din5008with_pin.latex
View File

@ -141,15 +141,18 @@ $endif$
$endfor$ $endfor$
} }
$if(apc-ident)$
\begin{textblock}{200}(5,5)%hpos,vpos
\textcolor{white!0}{$apc-ident$}%
\end{textblock}%
$endif$
$if(is-de)$ $if(is-de)$
\opening{$de-opening$} \opening{$de-opening$}
$else$ $else$
\opening{$en-opening$} \opening{$en-opening$}
$endif$ $endif$
\begin{textblock}{65}(142,21)%hpos,vpos
\textcolor{white!0}{\_\_\_$paper$\_\_\_$printid$\_\_\_}%
\end{textblock}
\begin{textblock}{65}(84,232)%hpos,vpos \begin{textblock}{65}(84,232)%hpos,vpos
\textcolor{black!39}{ \textcolor{black!39}{
\begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren! \begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren!

8
templates/letter/plain_article.latex
View File

@ -96,9 +96,11 @@ $endif$
\setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
\begin{document}% \begin{document}%
\begin{textblock}{65}(142,21)%hpos,vpos $if(apc-ident)$
\textcolor{white!0}{:::$paper$:::$printid$:::}% \begin{textblock}{200}(5,5)%hpos,vpos
\end{textblock} \textcolor{white!0}{$apc-ident$}%
\end{textblock}%
$endif$
$body$ $body$

20
test/Database/Fill.hs
View File

@ -597,16 +597,16 @@ fillDb = do
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing
void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk") void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk")
void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing
void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu")
void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu")
void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing
void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob8" "AckTestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn") void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
let let