chore(lpr): call lpr in qualfication renewal message

src/Handler/Course/Users.hs

@@ -513,7 +513,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , dbParamsFormResult   = id
           , dbParamsFormIdent    = def
           }
-        dbtCsvName = MsgCourseUserCsvName courseTerm courseSchool courseShorthand
+        dbtCsvName      = MsgCourseUserCsvName courseTerm courseSchool courseShorthand
         dbtCsvSheetName = MsgCourseUserCsvSheetName courseTerm courseSchool courseShorthand
         dbtCsvEncode = do
           csvColumns' <- csvColumns

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -52,7 +52,10 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
       -- content = $(i18nWidgetFile "qualification/renewal")
   $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualifiaction " <> qname
 
-  let pdfMeta = applyMetas [("recipient", userDisplayName)] mempty -- TODO: add more info to interpolate here!
+  let pdfMeta = applyMetas 
+                  [ ("recipient", userDisplayName)                  
+                  -- TODO: add more info to interpolate here!
+                  ] mempty
   pdfRenewal pdfMeta >>= \case
     Left err -> do
       let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err
@@ -81,7 +84,12 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
             -- TODO: this is just a dummy to continue while i18nHamletFile usage is unclear
             addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
 
-    Right _pdf | otherwise -> do
+    Right pdf | otherwise -> do
-        let _letterHead = error "TODO"
+        let printJobName = mempty --TODO
-        -- makePDF "pdflatex" [] writer woptions pandoc
+        lprPDF printJobName pdf >>= \case
-        error "TODO"
+          Left err -> do
+            let msg = "Notify " <> tshow jRecipient <> "  PDF printing to send letter failed with error: " <> err
+            $logErrorS "LMS" msg
+            error $ unpack msg
+          Right msg | null msg  -> return ()
+                    | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg

src/Utils/Print.hs

@@ -19,9 +19,9 @@ import System.Process.Typed -- for calling pdftk for pdf encryption
 
 -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
 
-{- Recall: 
+{- Recall:
   Funktionen außerhalb der Hanlder-Monade gehören in Utils-Module;
-  ansonsten drohen zyklische Abhängikeiten, d.h. 
+  ansonsten drohen zyklische Abhängikeiten, d.h.
   ggf. Funktionen in der HandlerFor-Monade nach Handler.Utils.Print verschieben!
 -}
 
@@ -63,8 +63,8 @@ makePDF wopts doc = do
     bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . LBS.toStrict)
 
 _Meta :: Lens' P.Pandoc P.Meta
-_Meta = lens mget mput 
+_Meta = lens mget mput
-  where 
+  where
     mget (P.Pandoc m _)   = m
     mput (P.Pandoc _ b) m = P.Pandoc m b
 
@@ -96,7 +96,7 @@ setIsDeFromLang m
     isde = "is-de"
 
 defReaderOpts :: P.ReaderOptions
-defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComments = True } 
+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 }
@@ -113,7 +113,7 @@ defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplat
 --   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    
+    tmpl <- compileTemplate    strictMarkupInput
     doc <- areader readerOpts strictMarkupInput
     let writerOpts = def { P.writerExtensions = P.pandocExtensions
                          , P.writerTemplate = Just tmpl }
@@ -143,7 +143,7 @@ reTemplateLetter' meta md  = do
   where
     readerOpts = def { P.readerExtensions    = P.pandocExtensions
                      , P.readerStripComments = True
-                     }    
+                     }
 
 
 --pdfDIN5008 :: P.PandocMonad m => Text -> m LBS.ByteString -- for pandoc > 2.18
@@ -179,25 +179,25 @@ pdfDIN5008 meta md = do
 
 -- | like 'reTemplateLetter' but uses 'templateRenewal' and caches the result
 mdRenewal' :: P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
-mdRenewal' meta = do 
+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 
+  case (e_doc, e_tmpl) of
-    (Left err, _) -> pure $ Left err 
+    (Left err, _) -> pure $ Left err
-    (_, 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 
+                            , 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 
+mdRenewal meta = runExceptT $ do
   let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                         , P.readerStripComments = True
                         }
@@ -207,22 +207,22 @@ mdRenewal meta = runExceptT $ do
                        , P.writerTemplate = Just tmpl
                        }
   ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
-                                                          $ addMeta meta doc  
+                                                          $ addMeta meta doc
 
 
 -- | combines 'mdRenewal' and 'pdfDIN5008'
 pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either Text LBS.ByteString)
 pdfRenewal meta = do
-  e_txt <- mdRenewal' meta 
+  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 
+pdfRenewal' meta = do
-  doc <- reTemplateLetter' meta templateRenewal   
+  doc <- reTemplateLetter' meta templateRenewal
-  pdfDIN5008' meta doc 
+  pdfDIN5008' meta doc
 
 
 
@@ -231,14 +231,14 @@ pdfRenewal' meta = do
 ---------------
 
 sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB FilePath
-sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do 
+sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do
   recipient <- join <$> mapM get printJobRecipient
   sender    <- join <$> mapM get printJobSender
   course    <- join <$> mapM get printJobCourse
   quali     <- join <$> mapM get printJobQualification
   let nameRecipient = userDisplayName <$> recipient
       nameSender    = userDisplayName <$> sender
-      nameCourse    = CI.original . courseShorthand        <$> course 
+      nameCourse    = CI.original . courseShorthand        <$> course
       nameQuali     = CI.original . qualificationShorthand <$> quali
   let printJobAcknowledged = Nothing
       printJobFilename = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
@@ -250,14 +250,14 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
   return printJobFilename
 
 sendLetter' :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB PureFile
-sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do 
+sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do
   recipient <- join <$> mapM get printJobRecipient
   sender    <- join <$> mapM get printJobSender
   course    <- join <$> mapM get printJobCourse
   quali     <- join <$> mapM get printJobQualification
   let nameRecipient = userDisplayName <$> recipient
       nameSender    = userDisplayName <$> sender
-      nameCourse    = CI.original . courseShorthand        <$> course 
+      nameCourse    = CI.original . courseShorthand        <$> course
       nameQuali     = CI.original . qualificationShorthand <$> quali
   let printJobAcknowledged = Nothing
       printJobFilename = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
@@ -269,7 +269,20 @@ sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse pri
   return $ File { fileTitle = printJobFilename
                 , fileModified = printJobCreated
                 , fileContent = Just $ yield printJobFile
-                } 
+                }
+
+
+-----------------------------
+-- 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 ususally might contain warning messages.
+--   To be used with 'System.Process.Typed.readProcess'
+exit2either :: (ExitCode, a, b) -> Either b a
+exit2either (ExitSuccess   , ok,   _) = Right ok   -- warnings are ignored here!
+exit2either (ExitFailure _ ,  _, err) = Left err
+
 
 
 -----------
@@ -284,7 +297,7 @@ sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse pri
 
 encryptPDF :: MonadIO m => String -> LBS.ByteString -> m (Either Text LBS.ByteString)
 encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
-  where 
+  where
     pc =  setStdin (byteStringInput bs) $
           proc "pdftk"  [ "-"                 -- read from stdin
                         , "output", "-"       -- write to stdout
@@ -295,6 +308,26 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
     -- 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.
-    exit2either :: (ExitCode, a, b) -> Either b a
+
-    exit2either (ExitSuccess   , ok,   _) = Right ok   -- warnings are ignored here!
+
-    exit2either (ExitFailure _ ,  _, err) = Left err 
+
+---------
+-- 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 -J printJobName -
+--
+
+lprPDF :: MonadIO m => String -> LBS.ByteString -> m (Either Text Text)
+lprPDF jb bs = over _Left  (decodeUtf8 . LBS.toStrict) .
+               over _Right (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
+  where
+    pc =  setStdin (byteStringInput bs) $
+          proc "lpr" $ [ "-P fradrive@fravm017173.fra.fraport.de:515"  -- queue@hostname:port TODO: turn this into a setting
+                       ] ++ jobname ++                                 -- a name for job identification at printing site
+                       [ "-"                                           -- read from stdin
+                       ]
+    jobname | null jb   = []
+            | otherwise = ["-J", jb]