-- SPDX-FileCopyrightText: 2022-23 Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module Utils.Print.Letters where -- import Import.NoModel import Import hiding (embedFile) import Data.FileEmbed (embedFile) import Data.Char as Char import qualified Data.Text as Text -- import qualified Data.CaseInsensitive as CI import qualified Data.Foldable as Fold import qualified Data.ByteString.Lazy as LBS import Control.Monad.Except import qualified Text.Pandoc as P import qualified Text.Pandoc.PDF as P import qualified Text.Pandoc.Builder as P import Text.Hamlet -- import System.Exit -- import System.Process.Typed -- for calling pdftk for pdf encryption -- import Handler.Utils.Users import Handler.Utils.DateTime -- import Handler.Utils.Mail -- import Handler.Utils.Widgets (nameHtml, nameHtml') -- import Handler.Utils.Avs (updateReceivers) -- import Jobs.Handler.SendNotification.Utils -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? -- instance P.ToMetaValue (CI Text) where -- toMetaValue = P.MetaString . CI.original ---------------------- -- Pandoc Functions -- ---------------------- -- Either I don't understand how pandoc works or -- I don't understand why these are not included compileTemplate :: (P.PandocMonad m) => Text -> m (P.Template Text) compileTemplate tmpl = do let partialPath = "" -- no partials used, see Text.DocTemplates mbTemplate <- P.runWithDefaultPartials $ P.compileTemplate partialPath tmpl liftEither $ str2pandocError mbTemplate where str2pandocError = over _Left $ P.PandocTemplateError . pack makePDF :: P.WriterOptions -> P.Pandoc -> P.PandocIO LBS.ByteString -- makePDF :: (PandocMonad m, MonadIO m, MonadMask m) => P.WriterOptions -> P.Pandoc -> m LBS.ByteString -- only pandoc >= 2.18 makePDF wopts doc = do mbPdf <- P.makePDF "lualatex" texopts P.writeLaTeX wopts doc liftEither $ bs2pandocError mbPdf where texopts = [] bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . LBS.toStrict) _Meta :: Lens' P.Pandoc P.Meta _Meta = lens mget mput where mget (P.Pandoc m _) = m mput (P.Pandoc _ b) m = P.Pandoc m b toMeta :: P.ToMetaValue a => Text -> a -> Map Text P.MetaValue toMeta k = singletonMap k . P.toMetaValue mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue mbMeta = foldMap . toMeta -- | For convenience and to avoid importing Pandoc mkMeta :: [Map Text P.MetaValue] -> P.Meta mkMeta = P.Meta . mconcat -- | Modify the Meta-Block of Pandoc appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs -- appMeta f = _Meta %~ f -- lens version. Not sure this is better -- TODO: applyMetas is inconvenient since we cannot have an instance -- ToMetaValue a => ToMetaValue (Maybe a) -- so apply Metas -- For tests see module PandocSpec applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, Maybe a) -> p -> p applyMetas metas doc = Fold.foldr act doc metas where act (k, Just v) acc | notNull k = P.setMeta k v acc act _ acc = acc -- | Add meta to pandoc. Existing variables will be overwritten. -- For specification, see module PandocSpec addMeta :: P.Meta -> P.Pandoc -> P.Pandoc addMeta m = appMeta (<> m) -- Data.Map says: (<>) == union and union should prefer the left operand, but somehow it does not! --addMeta m p = meta <> p -- where meta = P.Pandoc m mempty -- | Pandoc conditionals only test if a variable is set or isn't set. -- Variable "is-de" will be set to True if the "lang" variable starts with "de" -- and will be unset otherwise setIsDeFromLang :: P.Meta -> P.Meta setIsDeFromLang m | (Just (P.MetaString t)) <- P.lookupMeta "lang" m , isDe t = P.setMeta isde True m | otherwise = P.deleteMeta isde m where isde = "is-de" defReaderOpts :: P.ReaderOptions defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComments = True } defWriterOpts :: P.Template Text -> P.WriterOptions 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 -- Muss genau 5 Zeichen haben! paperKind PinLetter = "a4pin" -- Pin-Brief paperKind Plain = "a4wht" -- Ohne Logo paperKind Din5008 = "a4log" -- Mit Logo paperKind PlainLogo = "a4log" --------------- -- PrintJobs -- --------------- apcIdentSeparator :: Text apcIdentSeparator = Text.take 3 "___" -- must always have length 3 data PrintJobIdentification = PrintJobIdentification { pjiName :: Text , pjiApcAcknowledge :: Text , pjiRecipient :: Maybe UserId , pjiSender :: Maybe UserId , pjiCourse :: Maybe CourseId , pjiQualification :: Maybe QualificationId , pjiLmsUser :: Maybe LmsIdent , pjiFileName :: Text -- suggested filename, without suffix ".pdf" } deriving (Eq, Show) -- | create an identifier for printing with apc; which must always be place with the same length; exept for the last part which may be of variable length -- this is printed in white on white at the exact same position on the page -- Note: that all letters to the same UUID within 24h are collated in one envelope -- Example: 9ad8de3f-0a7e-ede5-bd8b-6d0ed85c1049-f___a4pin___230322-10___lms-stuvwxyz mkApcIdent :: CryptoUUIDUser -> Char -> LetterKind -> Text -> Text -> Text mkApcIdent uuid envelope lk tnow apcAck = Text.filter apcAcceptedChars $ Text.intercalate apcIdentSeparator [ ensureLength 38 $ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope) , ensureLength 5 $ paperKind lk , ensureLength 9 tnow , apcAck -- length may be arbitrary, thus far was always 12 ] where ensureLength :: Int -> Text -> Text ensureLength n = Text.take n . Text.justifyLeft n 'x' -- | 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 '-' = True apcAcceptedChars '_' = True apcAcceptedChars c = isAlphaNum c ------------------ -- 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 -} data EncryptPDFfor = NoPassword | PasswordSupervisor | PasswordUnderling deriving (Eq, Show) class MDLetter l where letterMeta :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta -- formatter/lang for individual receiver, set Meta "lang" for individually translated letters -- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver getPJId :: l -> PrintJobIdentification getLetterEnvelope :: l -> Char getLetterKind :: l -> LetterKind getTemplate :: l -> Text encryptPDFfor :: l -> EncryptPDFfor letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text letterApcIdent l uuid now = do -- now <- liftIO getCurrentTime tnow <- formatTime' "%y%m%d-%H" now return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l) letterFileName :: (MDLetter l) => l -> FilePath letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId addApcIdent :: Text -> P.Meta addApcIdent = P.Meta . toMeta "apc-ident" getApcIdent :: P.Meta -> Maybe Text getApcIdent (P.lookupMeta "apc-ident" -> Just (P.MetaString t)) = Just t getApcIdent _ = Nothing ---------------- -- Mail Class -- ---------------- -- this is for letters that may alternatively be sent as attachments to emails class MDMail 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