-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

module Utils.Print
  ( pdfRenewal
  , sendLetter, sendLetter'
  , sendEmailOrLetter
  , encryptPDF
  , sanitizeCmdArg, validCmdArgument
  , templateDIN5008
  , templateRenewal
  -- , compileTemplate, makePDF
  , _Meta, addMeta
  , toMeta, mbMeta                           -- single values
  , mkMeta, appMeta, applyMetas              -- multiple values
  , LetterRenewQualificationF(..)
  ) where

-- import Import.NoModel
import           Data.Char (isSeparator)
import qualified Data.Text as T
import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Fold

import qualified Data.ByteString.Lazy as LBS
import Control.Monad.Except
import Import hiding (embedFile)
import Data.FileEmbed (embedFile)

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')
import Jobs.Handler.SendNotification.Utils

-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?

{- Recall:
  Funktionen außerhalb der Hanlder-Monade gehören in Utils-Module;
  ansonsten drohen zyklische Abhängikeiten, d.h.
  ggf. Funktionen in der HandlerFor-Monade nach Handler.Utils.Print verschieben!
-}



-------------------------
-- Hardcoded Templates --
-------------------------

templateRenewal :: Text
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")

templateDIN5008 :: Text
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")


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



-------------------------
-- Readers and writers --
-------------------------

-- | Apply StoredMarkup as a template to itself and return the resulting Markup
--   This is a hack to allow variable interpolation within a document.
--   Pandoc currently only allows interpolation within templates.
--   An alternative Route would be to use Builders, but this prevents User-edited Markup Templates
reTemplateLetter :: P.PandocMonad m => P.Meta -> StoredMarkup -> m Text
reTemplateLetter meta StoredMarkup{..}  = do
    tmpl <- compileTemplate   strictMarkupInput
    doc <- areader readerOpts strictMarkupInput
    let writerOpts = def { P.writerExtensions = P.pandocExtensions
                         , P.writerTemplate = Just tmpl }
    P.writeMarkdown writerOpts
      $ appMeta setIsDeFromLang
      $ addMeta meta doc
  where
    strictMarkupInput = toStrict markupInput
    readerOpts = def { P.readerExtensions    = P.pandocExtensions
                     , P.readerStripComments = True
                     }
    -- reader :: (P.PandocMonad m, P.ToSources a)	 => P.ReaderOptions	-> a	-> m P.Pandoc
    areader = case markupInputFormat of
      MarkupHtml      -> P.readHtml
      MarkupMarkdown  -> P.readMarkdown
      MarkupPlaintext -> P.readMarkdown

reTemplateLetter' :: P.PandocMonad m => P.Meta -> Text -> m Text
reTemplateLetter' meta md  = do
    tmpl <- compileTemplate md
    doc <- P.readMarkdown readerOpts md
    let writerOpts = def { P.writerExtensions = P.pandocExtensions
                         , P.writerTemplate = Just tmpl }
    P.writeMarkdown writerOpts
      $ appMeta setIsDeFromLang
      $ addMeta meta doc
  where
    readerOpts = def { P.readerExtensions    = P.pandocExtensions
                     , P.readerStripComments = True
                     }

mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
mdTemplating template meta = runExceptT $ do
  let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                        , P.readerStripComments = True
                        }
  doc  <- ExceptT $ $cachedHereBinary ("pandoc: \n"   <> template) (pure . P.runPure $ P.readMarkdown readerOpts template)
  tmpl <- ExceptT $ $cachedHereBinary ("template: \n" <> template) (pure . P.runPure $ compileTemplate template)
  let writerOpts = def { P.writerExtensions = P.pandocExtensions
                       , P.writerTemplate = Just tmpl
                       }
  ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
                                                          $ addMeta meta doc

--pdfDIN5008 :: P.PandocMonad m => Text -> m LBS.ByteString -- for pandoc > 2.18
pdfDIN5008' :: P.Meta -> Text -> P.PandocIO LBS.ByteString
pdfDIN5008' meta md = do
  tmpl <- compileTemplate templateDIN5008
  let readerOpts  = def { P.readerExtensions = P.pandocExtensions }
      writerOpts  = def { P.writerExtensions = P.pandocExtensions
                        , P.writerTemplate   = Just tmpl }
  doc <- P.readMarkdown readerOpts md
  makePDF writerOpts
    $ appMeta setIsDeFromLang
    $ addMeta meta doc

-- | creates a PDF using the din5008 template
pdfDIN5008 :: P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
pdfDIN5008 meta md = do
  e_tmpl <- $cachedHereBinary ("din5008"::Text) (liftIO . P.runIO $ compileTemplate templateDIN5008)
  actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
      let readerOpts  = def { P.readerExtensions = P.pandocExtensions }
          writerOpts  = def { P.writerExtensions = P.pandocExtensions
                            , P.writerTemplate   = Just tmpl }
      doc <- P.readMarkdown readerOpts md
      makePDF writerOpts
        $ appMeta setIsDeFromLang
        $ addMeta meta doc



-------------------------
-- Specialized Letters --
-------------------------

-- | like 'reTemplateLetter' but uses 'templateRenewal' and caches the result
mdRenewal' :: P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
mdRenewal' meta = do
  let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                        , P.readerStripComments = True
                        }
  e_doc  <- $cachedHereBinary ("renewal-pandoc"::Text)   (liftIO . P.runIO $ P.readMarkdown readerOpts templateRenewal)
  e_tmpl <- $cachedHereBinary ("renewal-template"::Text) (liftIO . P.runIO $ compileTemplate templateRenewal)
  case (e_doc, e_tmpl) of
    (Left err, _) -> pure $ Left err
    (_, Left err) -> pure $ Left err
    (Right md_doc, Right md_tmpl) -> do
      let writerOpts = def  { P.writerExtensions = P.pandocExtensions
                            , P.writerTemplate   = Just md_tmpl
                            }
      liftIO . P.runIO $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
                                                    $ addMeta meta md_doc

-- | like 'reTemplateLetter' but uses 'templateRenewal' and caches the result
mdRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
mdRenewal meta = runExceptT $ do
  let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                        , P.readerStripComments = True
                        }
  doc  <- ExceptT $ $cachedHereBinary ("renewal-pandoc"::Text)   (pure . P.runPure $ P.readMarkdown readerOpts templateRenewal)
  tmpl <- ExceptT $ $cachedHereBinary ("renewal-template"::Text) (pure . P.runPure $ compileTemplate templateRenewal)
  let writerOpts = def { P.writerExtensions = P.pandocExtensions
                       , P.writerTemplate = Just tmpl
                       }
  ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
                                                          $ addMeta meta doc


-- | combines 'mdRenewal' and 'pdfDIN5008'
pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either Text LBS.ByteString)
pdfRenewal meta = do
  e_txt <- mdRenewal' meta
  --actRight e_txt (pdfDIN5008 . appMeta setIsDeFromLang . addMeta meta) -- try this
  result <- actRight e_txt $ pdfDIN5008 meta
  return $ over _Left P.renderError result

-- | like pdfRenewal but without caching
pdfRenewal' :: P.Meta -> P.PandocIO LBS.ByteString
pdfRenewal' meta = do
  doc <- reTemplateLetter' meta templateRenewal
  pdfDIN5008' meta doc


-- Generic Version
pdfLetter :: Text -> P.Meta -> HandlerFor UniWorX (Either Text LBS.ByteString)
pdfLetter md meta = do
  e_txt <- mdTemplating md meta
  result <- actRight e_txt $ pdfDIN5008 meta
  return $ over _Left P.renderError result


---------------
-- PrintJobs --
---------------

data PrintJobIdentification = PrintJobIdentification
      { pjiName           :: Text
      , pjiRecipient      :: Maybe UserId
      , pjiSender         :: Maybe UserId
      , pjiCourse         :: Maybe CourseId
      , pjiQualification  :: Maybe QualificationId
      , pjiLmsUser        :: Maybe LmsIdent
      }
  deriving (Eq, Show)

-- DEPRECATED
sendLetter' :: 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 pdf PrintJobIdentification
    { pjiName = printJobName
    , pjiRecipient = printJobRecipient
    , pjiSender = printJobSender
    , pjiCourse = printJobCourse
    , pjiQualification = printJobQualification
    , pjiLmsUser = printJobLmsUser
    }

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
  recipient <- join <$> mapM get printJobRecipient
  sender    <- join <$> mapM get printJobSender
  course    <- join <$> mapM get printJobCourse
  quali     <- join <$> mapM get printJobQualification
  let nameRecipient = abbrvName <$> recipient
      nameSender    = abbrvName <$> sender
      nameCourse    = CI.original . courseShorthand        <$> course
      nameQuali     = CI.original . qualificationShorthand <$> quali
  let jobFullName          = text2asciiAlphaNum $
                             T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
      printJobFilename     = T.unpack $ jobFullName <> ".pdf"
      -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
      printJobFile = LBS.toStrict pdf
      printJobAcknowledged = Nothing
  lprPDF jobFullName pdf >>= \case
    Left err -> do
      return $ Left err
    Right ok -> do
      printJobCreated <- liftIO getCurrentTime
      -- updateWhere [PrintJobLmsUser ==. printJobLmsUser] [PrintJobLmsUser =. Nothing] -- only one printJob per LmsUser is allowed, since otherwise the qualification table contains double rows
      insert_ PrintJob {..}
      return $ Right (ok, printJobFilename)

{-
sendLetter'' :: _ -> DB PureFile
sendLetter'' _ = do
  ...
  return $ File { fileTitle = printJobFilename
                , fileModified = printJobCreated
                , fileContent = Just $ yield printJobFile
                }
-}


{- 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
  getTemplate     :: Proxy l -> Text
  getMailSubject  :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
  getMailBody     :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
  letterMeta      :: l -> Lang -> DateTimeFormatter -> P.Meta
  getPJId         :: l -> PrintJobIdentification

data LetterRenewQualificationF = LetterRenewQualificationF
    { lmsLogin      :: LmsIdent
    , lmsPin        :: Text
    , qualHolder    :: UserDisplayName
    , qualExpiry    :: Day
    , qualId        :: QualificationId
    , qualName      :: Text
    , qualShort     :: Text
    , qualDuration  :: Maybe Int
    }
  deriving (Eq, Show)

instance MDLetter LetterRenewQualificationF where
  getTemplate     _ = templateRenewal
  getMailSubject  l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
  getMailBody     l = SomeMessage $ MsgMailBodyQualificationRenewal    $ qualName  l
  letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta
      [ toMeta "login"          lmsIdent
      , toMeta "pin"            lmsPin
      , toMeta "examinee"       qualHolder
      , toMeta "expiry"         (format SelFormatDate qualExpiry)
      , mbMeta "validduration"  (show <$> qualDuration)
      , toMeta "url-text"       lmsUrl
      , toMeta "url"            lmsUrlLogin
      ]
    where
      lmsUrl      = "https://drive.fraport.de"
      lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
      lmsIdent    = getLmsIdent lmsLogin
  getPJId LetterRenewQualificationF{..} =
    PrintJobIdentification
      { pjiName             = "Renewal"
      , pjiRecipient        = Nothing       -- to be filled later
      , pjiSender           = Nothing
      , pjiCourse           = Nothing
      , pjiQualification    = Just qualId
      , pjiLmsUser          = Just lmsLogin
      }

sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do
  (underling, receivers, undercopy) <- runDB $ getReceivers recipient
  let tmpl = getTemplate $ pure letter
      pjid = getPJId letter
      -- Below are only needed if sent by email
      mailSubject = getMailSubject letter
      mailBody    = getMailBody    letter
      undername = underling ^. _userDisplayName -- nameHtml' underling
      undermail = CI.original $ underling ^. _userEmail
  now <- liftIO getCurrentTime
  oks <- forM receivers $ \Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
    formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr
    let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
        isSupervised = recipient /= svr
        lang  = selectDeEn $ rcvrUsr & userLanguages   -- select either German or English only, default de; see Utils.Lang
        lMeta = letterMeta letter lang formatter <> mkMeta (                  
                  ( if isSupervised 
                    then 
                      [ toMeta "supervisor" (rcvrUsr & userDisplayName)
                      , toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
                      , toMeta "en-opening" ("Dear Sir or Madam,"::Text)
                      ] 
                    else []                  
                  ) <> 
                      [ toMeta "lang"         lang
                      , toMeta "date"       $ format SelFormatDate now
                      , toMeta "address"    $ fromMaybe [rcvrUsr & userDisplayName] postal
                      ]
                  )
                  
    pdfLetter tmpl lMeta >>= \case
      _ | 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
        $logErrorS "LETTER" msg
        return False
      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
        $logErrorS "LETTER" msg
        return False
      Right pdf | preferPost -> -- send letter
        runDB (sendLetter pdf pjid{ pjiRecipient = Just svr}) >>= \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
            $logErrorS "LETTER" msg
            return False
          Right (msg,_)
            | null msg  -> return True
            | otherwise -> do
                $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
                return True
      Right pdf -> do -- send email
        attachment <- case userPinPassword rcvrUsr of
          Nothing     -> return pdf
          Just passwd -> encryptPDF passwd pdf >>= \case
            Right encPdf -> return encPdf
            Left err -> do
              encRecipient :: CryptoUUIDUser <- encrypt svr
              let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
              $logWarnS "LETTER" msg
              return pdf
        userMailTdirect svr $ do
          replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
          setSubjectI mailSubject
          editNotifications <- mkEditNotifications svr
          let supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
          addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
          addPart (File { fileTitle     = T.unpack $ pjiName pjid <> ".pdf"
                        , fileModified  = now
                        , fileContent   = Just $ yield $ LBS.toStrict attachment
                        } :: PureFile)
          return True
  return $ or oks


-----------------------------
-- Typed Process Utilities --
-----------------------------

-- | Converts Triple consisting of @ExitCode@, Success- and Failure-Value to Either Failue- or Success-Value.
--   Returns @Right@  if the @ExitCode@ is @ExitsSuccess, entirely ignoring the Failure-Value, which might contain warning messages.
--   To be used with 'System.Process.Typed.readProcess'
exit2either :: Monoid a => (ExitCode, a, a) -> Either a a
exit2either (ExitSuccess   , stdOut,  errOut) = Right $ stdOut <> errOut
exit2either (ExitFailure _ , stdOut,  errOut) = Left  $ stdOut <> errOut


readProcess' :: MonadIO m => ProcessConfig stdin stdoutIgnored stderrIgnored -> m (ExitCode, Text, Text)
readProcess' pc = do
  (ec, bs_err, bs_out) <- readProcess pc
  let st_err = decodeUtf8 $ LBS.toStrict bs_err
      st_out = decodeUtf8 $ LBS.toStrict bs_out
  return (ec, st_err, st_out)


sanitizeCmdArg :: Text -> Text
sanitizeCmdArg =  T.filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c))
-- | Returns Nothing if ok, otherwise the first mismatching character
--   Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk
validCmdArgument :: Text -> Maybe Char
validCmdArgument t = t `textDiff` sanitizeCmdArg t


-----------
-- pdftk --
-----------
--
-- We use the external tool pdftk for PDF encryption like so
--  > pdftk in.pdf output out.pdf user_pw tomatenmarmelade
-- we can use stdin and std out like so
--  > pdftk - output - user_pw tomatenmarmelade
--

encryptPDF :: MonadIO m => Text -> LBS.ByteString -> m (Either Text LBS.ByteString)
encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
  where
    pw' = sanitizeCmdArg pw
    pc  = setStdin (byteStringInput bs) $
          proc "pdftk"  [ "-"                     -- read from stdin
                        , "output", "-"           -- write to stdout
                        , "user_pw", T.unpack pw' -- encrypt pdf content
                        , "dont_ask"              -- no interaction
                        , "allow", "Printing"     -- allow printing despite encryption
                        ]
    -- Note that pdftk will issue a warning, which will be ignored:
    --    Warning: Using a password on the command line interface can be insecure.
    --    Use the keyword PROMPT to supply a password via standard input instead.


---------
-- lpr --
---------
--
-- We use the external tool lpr in the variant supplied by busybox
-- to print pdfs like so:
--  > lpr -P fradrive@fravm017173.fra.fraport.de:515 -J printJobName -
--
-- 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
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Text -> LBS.ByteString -> m (Either Text Text)
lprPDF jb bs = do
    lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
    let pc = setStdin (byteStringInput bs) $
              proc "lpr" $
                jobname ++                                      -- -J jobname -- a name for job identification at printing site
                [ lprServerArg                                  -- -P queue@hostname:port
                , "-"                                           -- read from stdin
                ]
        jobname | null jb   = []
                | otherwise = ["-J " <> jb']
        jb' = T.unpack $ sanitizeCmdArg jb
    exit2either <$> readProcess' pc
  where
    getLprServerArg = do
      LprConf{..} <- getsYesod $ view _appLprConf
      return $ "-P " <> lprQueue <> "@" <> lprHost <> ":" <> show lprPort


{- -- Variant without caching
lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
lprPDF' jb bs = do
  LprConf{..} <- getsYesod $ view _appLprConf
  let lprServer = lprQueue <> "@" <> lprHost <> ":" <> show lprPort
      pc =  setStdin (byteStringInput bs) $
            proc "lpr" $ [ "-P " <> lprServer                            -- queue@hostname:port
                         ] ++ jobname ++                                 -- a name for job identification at printing site
                         [ "-"                                           -- read from stdin
                         ]
      jobname | null jb   = []
              | otherwise = ["-J " <> jb]
  exit2either <$> readProcess' pc
-}
