lpr: link lpr calls and printJob db entries for actual printing

models/lms.model

@@ -77,7 +77,7 @@ QualificationUser
   --         + if contained:
   --              set LmsUserReceived to Just now()
   --              if LmsUserlistFailed: set LmsUserStatus to Just Day  
-  --         + not contianed, by LmsUserReceived is set: set LmsUserEnded to Just now()
+  --         + not contained, by LmsUserReceived is set: set LmsUserEnded to Just now()
   --     - move row to LmsAudit
   --
   -- 6. When received: Daily Job LmsResult:

src/Handler/PrintCenter.hs

@@ -313,10 +313,16 @@ postPrintSendR = do
             -- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
             -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
             uID <- maybeAuthId
-            filepath <- runDB $ sendLetter "Test-Brief" bs mbRecipient uID Nothing Nothing
+            runDB (sendLetter "Test-Brief" bs mbRecipient uID Nothing Nothing) >>= \case -- calls lpr 
-            addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> filepath
+              Left err -> do
-            -- TODO: continue here with acutal letter sending!
+                let msg = "PDF printing failed with error: " <> err
-            pure True
+                $logErrorS "LPR" msg
+                addMessage Error $ toHtml msg
+                pure False
+              Right (ok, fpath) -> do 
+                let response = if null ok then mempty else  " Response: " <> ok
+                addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response
+                pure True
           (Nothing, Left err) -> do
             addMessage Error $ toHtml err
             pure False

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -50,7 +50,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
     <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
   let qname = CI.original qualificationName
       -- content = $(i18nWidgetFile "qualification/renewal")
-  $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualifiaction " <> qname
+  $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualification " <> qname
 
   let pdfMeta = applyMetas 
                   [ ("recipient", userDisplayName)                  
@@ -85,11 +85,14 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
             addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
 
     Right pdf | otherwise -> do
-        let printJobName = mempty --TODO
+        let printJobName = mempty  --TODO
-        lprPDF printJobName pdf >>= \case
+            printSender  = Nothing --TODO
+        runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case
+        -- lprPDF printJobName pdf >>= \case
           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 ()
+          Right (msg,_) 
-                    | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> 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

@@ -230,7 +230,7 @@ pdfRenewal' meta = do
 -- PrintJobs --
 ---------------
 
-sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB FilePath
+sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB (Either Text (Text, FilePath))
 sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do
   recipient <- join <$> mapM get printJobRecipient
   sender    <- join <$> mapM get printJobSender
@@ -241,14 +241,19 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
       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"
+      jobFullName           = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) 
+      printJobFilename  = jobFullName <> ".pdf"
       -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
-      printJobFile = LBS.toStrict pdf
+      printJobFile = LBS.toStrict pdf  
-  -- TODO: system call to lpr here!
+  lprPDF jobFullName pdf >>= \case  
-  printJobCreated <- liftIO getCurrentTime
+    Left err -> do       
-  insert_ PrintJob {..}
+      return $ Left err
-  return printJobFilename
+    Right ok -> do      
+      printJobCreated <- liftIO getCurrentTime
+      insert_ PrintJob {..}
+      return $ Right (ok, printJobFilename)
 
+{-
 sendLetter' :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB PureFile
 sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do
   recipient <- join <$> mapM get printJobRecipient
@@ -260,17 +265,18 @@ sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse pri
       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"
+      jobFullName     = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
+      printJobFilename = jobFullName <> ".pdf"
       -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
-      printJobFile = LBS.toStrict pdf
+      printJobFile = LBS.toStrict pdf  
-  -- TODO: system call to lpr here!
+  lprPDF jobFullName pdf
   printJobCreated <- liftIO getCurrentTime
   insert_ PrintJob {..}
   return $ File { fileTitle = printJobFilename
                 , fileModified = printJobCreated
                 , fileContent = Just $ yield printJobFile
                 }
-
+-}
 
 -----------------------------
 -- Typed Process Utilities --
@@ -329,6 +335,10 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
 -- The cups version of lpr is instead used like so:
 --  > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
 
+
+-- TODO: consider hiding this function within the export, as it does not create an entry in the printJob table in the DB
+
+-- | Internal, use `sendLetter` instead
 lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
 lprPDF jb bs = do 
     lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg