-- SPDX-FileCopyrightText: 2022-23 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
  ( renderLetterPDF        -- used for generating letter pdfs
  , renderLetters
  , sendEmailOrLetter   -- directly print or sends by email
  , printLetter         -- always send a letter
  , printHtml           -- return letter as Html only
  , reprintPDF          -- send a PDF once more the APC
  , letterApcIdent      -- create acknowledge string for APC
  , letterFileName      -- default filename
  , encryptPDF
  , sanitizeCmdArg, sanitizeCmdArg', validCmdArgument
  -- , compileTemplate, makePDF
  , _Meta, addMeta
  , toMeta, mbMeta                           -- single values
  , mkMeta, appMeta, applyMetas              -- multiple values
  -- , MDMail
  -- , MDLetter
  , SomeLetter(..)
  , LetterRenewQualificationF(..)
  , LetterExpireQualification(..)
  -- , LetterCourseCertificate()
  , makeCourseCertificates
  ) 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.Memcached
import Handler.Utils.Users
import Handler.Utils.DateTime
import Handler.Utils.Mail
import Handler.Utils.Widgets (nameHtml')
import Handler.Utils.Avs (updateReceivers)
import Jobs.Handler.SendNotification.Utils

import Utils.Print.Instances ()
import Utils.Print.Letters
import Utils.Print.SomeLetter
import Utils.Print.RenewQualification
import Utils.Print.ExpireQualification
import Utils.Print.CourseCertificate


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



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


-- | read and writes markdown, applying it as its own template to apply meta
mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either Text P.Pandoc)
mdTemplating template meta = runExceptT $ do
  let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                        , P.readerStripComments = True
                        }
  -- doc  <- ExceptT (pure . over _Left P.renderError . P.runPure $ P.readMarkdown readerOpts template)
  -- tmpl <- ExceptT (pure . over _Left P.renderError . P.runPure $ compileTemplate template)
  doc  <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("pandoc-md: \n"   <> template) (pure . over _Left P.renderError . P.runPure $ P.readMarkdown readerOpts template)
  tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("template-md: \n" <> template) (pure . over _Left P.renderError . P.runPure $ compileTemplate template)
  let writerOpts = def { P.writerExtensions = P.pandocExtensions
                       , P.writerTemplate = Just tmpl
                       }
  ExceptT . pure . over _Left P.renderError . P.runPure $ do
    md_txt <- P.writeMarkdown writerOpts $ appMeta setIsDeFromLang $ addMeta meta doc    
    addMeta meta <$> P.readMarkdown readerOpts md_txt -- NOTE: meta is lost along the way somehow, despite P.pandocExtensions containing Ext_yaml_metadata_block
    


-- | creates a PDF using a LaTeX template
pdfLaTeX :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either Text LBS.ByteString)
pdfLaTeX lk doc = do
  -- e_tmpl <- fmap (over _Left P.renderError) . liftIO . P.runIO $ compileTemplate $ templateLatex lk
  e_tmpl <- memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-latex: \n" <> tshow lk) (fmap (over _Left P.renderError) . liftIO . P.runIO $ compileTemplate $ templateLatex lk)
  actRight e_tmpl $ \tmpl -> fmap (over _Left P.renderError) . liftIO . P.runIO $ do
      let writerOpts  = def { P.writerExtensions = P.pandocExtensions
                            , P.writerTemplate   = Just tmpl }      
      makePDF writerOpts $ appMeta setIsDeFromLang doc
      

renderLetterPDF :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
renderLetterPDF rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
  now <- liftIO getCurrentTime  
  formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
  let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
      kind = getLetterKind        mdl
      tmpl = getTemplate          mdl
      meta = addApcIdent apcIdent
          <> letterMeta mdl formatter lang rcvrEnt
          <> mkMeta
            [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
              toMeta "date"       $ format SelFormatDate now
            , toMeta "rcvr-name"  $ rcvr & userDisplayName
            , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
            --, toMeta "rcvr-email"    $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
            ]
  e_md <- mdTemplating tmpl meta
  actRight e_md $ pdfLaTeX kind


renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html)
renderLetterHtml rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
    now <- liftIO getCurrentTime  
    formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
    let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang
        kind = getLetterKind        mdl
        tmpl = getTemplate          mdl
        meta = addApcIdent apcIdent
            <> letterMeta mdl formatter lang rcvrEnt
            <> mkMeta
              [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
                toMeta "date"       $ format SelFormatDate now
              , toMeta "rcvr-name"  $ rcvr & userDisplayName
              , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
              --, toMeta "rcvr-email"    $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
              ]
    e_md <- mdTemplating tmpl meta
    actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do   
      html_tmpl <- compileTemplate $ templateHtml kind
      -- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk)
      let writerOpts  = def { P.writerExtensions = P.pandocExtensions
                            , P.writerTemplate   = Just html_tmpl }
      P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md

-- TODO: apcIdent does not make sense for multiple letters 
renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent 
  | Just l <- anyone mdls = do
      now <- liftIO getCurrentTime  
      formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
      let lang = selectDeEn $ rcvr & userLanguages   -- select either German or English only, default de; see Utils.Lang      
          kind = getLetterKind l
          
          templateCombine _   err@Left{}  = pure err
          templateCombine mdl (Right doc1) =
            let tmpl = getTemplate mdl
                meta = addApcIdent apcIdent
                        <> letterMeta mdl formatter lang rcvrEnt
                        <> mkMeta
                          [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
                            toMeta "date"       $ format SelFormatDate now
                          , toMeta "rcvr-name"  $ rcvr & userDisplayName
                          , toMeta "address"    $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
                          --, toMeta "rcvr-email"    $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
                          ]
            in mdTemplating tmpl meta <&> \case 
                err@Left{} -> err
                Right doc2 -> Right $ doc1 <> doc2

      doc <- foldrM templateCombine (Right mempty) mdls
      -- result <- actRight doc $ pdfLaTeX kind
      -- return $ over _Left P.renderError result
      actRight doc $ pdfLaTeX kind
  | otherwise = return $ Left "renderLetters received empty set of letters"


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

-- Only used in print-test-handler for PrintSendR
printHtml ::  (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text Html)
printHtml _senderId (rcvr, letter) = do
  let rcvrId = rcvr ^. _entityKey
  encRecipient :: CryptoUUIDUser <- encrypt rcvrId
  now <- liftIO getCurrentTime
  apcIdent <- letterApcIdent letter encRecipient now
  renderLetterHtml rcvr letter apcIdent
  
-- Only used in print-test-handler for PrintSendR
printLetter :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text (Text, FilePath))
printLetter senderId (rcvr, letter) = do
  let rcvrId = rcvr ^. _entityKey
  encRecipient :: CryptoUUIDUser <- encrypt rcvrId
  now <- liftIO getCurrentTime
  apcIdent <- letterApcIdent letter encRecipient now
  pdf <- renderLetterPDF rcvr letter apcIdent
  let protoPji = getPJId letter 
      pji = protoPji 
              { pjiRecipient = Just rcvrId
              , pjiSender = senderId
              , pjiName = "TEST_" <> pjiName protoPji
              , pjiApcAcknowledge = apcIdent
              }
  actRight pdf $ runDB . printLetter' pji

printLetter' :: PrintJobIdentification -> LBS.ByteString -> DB (Either Text (Text, FilePath))
printLetter' pji pdf = do
  let PrintJobIdentification
        { pjiName           = printJobName
        , pjiApcAcknowledge = printJobApcIdent
        , pjiRecipient      = printJobRecipient
        , pjiSender         = printJobSender
        , pjiCourse         = printJobCourse
        , pjiQualification  = printJobQualification
        , pjiLmsUser        = printJobLmsUser
        , pjiFileName       = fName
        } = pji
      printJobFilename = T.unpack $ text2asciiAlphaNum fName <> ".pdf"
      -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
      printJobFile = LBS.toStrict pdf
      printJobAcknowledged = Nothing
  qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get
  let logInter = flip (logInterface "Printer" qshort) (Just 1)
  lprPDF printJobFilename pdf >>= \case
    Left err -> do
      logInter False err
      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{..}
      logInter True ok
      return $ Right (ok, printJobFilename)

reprintPDF :: Bool -> PrintJobId -> DB (Either Text Text)
reprintPDF ignoreReroute pjid = maybeM (return $ Left "Print job id is unknown.") reprint $ get pjid
  where 
    reprint :: PrintJob -> DB (Either Text Text)
    reprint pj@PrintJob{..} = do 
      qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get  
      let logInter = flip (logInterface "Printer" qshort) (Just 1)
      result <- lprPDF' ignoreReroute printJobFilename $ LBS.fromStrict printJobFile
      case result of
        Left err -> 
          logInter False err
        Right m -> do
          logInter True m
          now <- liftIO getCurrentTime        
          insert_ pj{ printJobAcknowledged  = Nothing
                    , printJobCreated       = now
                    -- , printJobApcIdent      = ??? cannot be modified here, since it is included inside the PDF
                    }
      return result

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

sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do  
  (underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
  now <- liftIO getCurrentTime
  mr <- getMessageRender
  let pjid  = getPJId letter
      fName = letterFileName letter
      -- these are only needed if sent by email, but we're lazy anyway      
      undername         = underling ^. _userDisplayName -- nameHtml' underling
      undermail         = CI.original $ underling ^. _userEmail      
      mailSubjectRaw    = getMailSubject letter       
      mailSubjectSuper  = SomeMessage $ "[SUPERVISOR] " <> mr mailSubjectRaw
      mkMailSubject     = bool mailSubjectRaw mailSubjectSuper
      mkMailBody        = getMailBody letter
  oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
    let supername     = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
        isSupervised  = recipient /= svr
        mailSubject   = mkMailSubject isSupervised
    encRecipient :: CryptoUUIDUser <- encrypt svr
    apcIdent <- letterApcIdent letter encRecipient now
    case getPostalPreferenceAndAddress rcvrUsr of 
      (True, Nothing) -> do -- neither email nor postal is known
        let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
        $logErrorS "LETTER" msg
        return False

      (True , Just _postal) -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send printed letter
          Left err -> do -- pdf generation failed 
            let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
            $logErrorS "LETTER" msg
            return False  
          Right pdf -> runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
            Left err -> do            
              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

      (False, _) | Just mkMail <- mkMailBody -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, but with pdf attached 
          Left err -> do -- pdf generation failed 
            let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
            $logErrorS "LETTER" msg
            return False  
          Right pdf -> do -- pdf generated, send as email attachment now
            let pdfPass = case encryptPDFfor letter of 
                  NoPassword          -> Nothing
                  PasswordSupervisor  -> rcvrUsr   ^. _userPinPassword
                  PasswordUnderling   -> underling ^. _userPinPassword
            attachment <- case pdfPass of
              Nothing     -> return pdf
              Just passwd -> encryptPDF passwd pdf >>= \case
                Right encPdf -> return encPdf
                Left err -> do              
                  let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
                  $logWarnS "LETTER" msg
                  return pdf
            formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
            let mailBody = mkMail formatter
            userMailTdirect svr $ do
              replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
              setSubjectI mailSubject
              editNotifications <- mkEditNotifications svr
              addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet") -- wrapper for mailBody
              addPart (File { fileTitle     = fName
                            , fileModified  = now
                            , fileContent   = Just $ yield $ LBS.toStrict attachment
                            } :: PureFile)
            return True

      (False, _) -> renderLetterHtml rcvrEnt letter apcIdent >>= \case -- send Email, render letter directly to html
          Left err -> do -- html generation failed 
            let msg = "Notification failed for " <> tshow encRecipient <> ". HTML generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
            $logErrorS "LETTER" msg
            return False  
          Right html -> do -- html generated, send directly now                  
            userMailTdirect svr $ do
              replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
              setSubjectI mailSubject              
              addHtmlMarkdownAlternatives html
            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))

sanitizeCmdArg' :: String -> String
sanitizeCmdArg' =  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 $ T.strip 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 `printLetter` instead
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => FilePath -> LBS.ByteString -> m (Either Text Text)
lprPDF = lprPDF' False

lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Bool -> FilePath -> LBS.ByteString -> m (Either Text Text)
lprPDF' ignoreReroute (sanitizeCmdArg' -> jb) bs = maybeM hdlFail hdlLpr getLprServerArg
  where 
    hdlFail = return $ Right "Print command ignored due to setting 'mail-reroute-to' being set."
    
    hdlLpr lprServerArg = do
      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]            
      exit2either <$> readProcess' pc
    
    getLprServerArg = do
      rerouteMail <- getsYesod $ view _appMailRerouteTo
      case (ignoreReroute, rerouteMail) of
        (False, Just _) -> return Nothing
        _ -> do
          LprConf{..} <- getsYesod $ view _appLprConf
          return . Just $ "-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
-}
