diff --git a/models/lms.model b/models/lms.model index cc476406a..8486ccc5a 100644 --- a/models/lms.model +++ b/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: diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 3971d76dc..6afaff9a2 100644 --- a/src/Handler/PrintCenter.hs +++ b/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 - addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> filepath - -- TODO: continue here with acutal letter sending! - pure True + runDB (sendLetter "Test-Brief" bs mbRecipient uID Nothing Nothing) >>= \case -- calls lpr + Left err -> do + let msg = "PDF printing failed with error: " <> err + $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 diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index fc3b72d21..2469d1f1d 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/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 - lprPDF printJobName pdf >>= \case + let printJobName = mempty --TODO + 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 () - | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg \ No newline at end of file + Right (msg,_) + | null msg -> return () + | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg \ No newline at end of file diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 623db5032..26f45226c 100644 --- a/src/Utils/Print.hs +++ b/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 - -- TODO: system call to lpr here! - printJobCreated <- liftIO getCurrentTime - insert_ PrintJob {..} - return printJobFilename + printJobFile = LBS.toStrict pdf + lprPDF jobFullName pdf >>= \case + Left err -> do + return $ Left err + 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 - -- TODO: system call to lpr here! + printJobFile = LBS.toStrict pdf + 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