fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(lpr): fix sender recipient switch and remove printjob uuid column from print center

Browse Source
This commit is contained in:
Steffen Jost 2022-09-09 13:29:40 +02:00
parent 2221b30771
commit fc926c23cb
3 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Handler/PrintCenter.hs
View File

@ -183,21 +183,16 @@ mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget)
mkPJTable = do
currentRoute <- fromMaybe (error "mkPJTable called from 404-handler") <$> liftHandler getCurrentRoute -- albeit we do know the route here
let
showId :: PrintJobId -> Widget
showId k = do
c <- encrypt k
let f :: CryptoUUIDPrintJob -> Text
f x = toPathPiece x
[whamlet|#{f c}|]
dbtSQLQuery = pjTableQuery
dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat
[ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
, sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
, sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
, sortable (Just "pj-filename") (i18nCell MsgPrintJobFilename) $ \( view $ resultPrintJob . _entityVal . _printJobFilename -> t) -> textCell t
, sortable (toNothingS "pdf") (i18nCell MsgPrintPDF) $ \( view $ resultPrintJob . _entityKey -> k) -> anchorCellM (PrintDownloadR <$> encrypt k) (showId k)
, sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
, sortable (Just "pj-filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey
t = r ^. resultPrintJob . _entityVal . _printJobFilename
in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t)
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow . E.unSqlBackendKey $ unPrintJobKey k)
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> cell (showId k)
, sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
@ -307,7 +302,7 @@ postPrintSendR = do
-- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
-- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
uID <- maybeAuthId
runDB (sendLetter "Test-Brief" bs mbRecipient uID Nothing Nothing) >>= \case -- calls lpr
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

2
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -87,7 +87,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
Right pdf | userPrefersLetter recipient -> do
let printSender = Nothing
runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case
runDB (sendLetter printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification)) >>= \case
Left err -> do
let msg = "Notify " <> tshow encRecipient <> " PDF printing to send letter failed with error: " <> err
$logErrorS "LMS" msg

8
src/Utils/Print.hs
View File

@ -263,8 +263,8 @@ pdfRenewal' meta = do
-- PrintJobs --
---------------
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
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
course <- join <$> mapM get printJobCourse
@ -280,6 +280,10 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
printJobFile = LBS.toStrict pdf
lprPDF jobFullName pdf >>= \case
Left err -> do
-- for testing
printJobCreated <- liftIO getCurrentTime
insert_ PrintJob {..}
-- for testing
return $ Left err
Right ok -> do
printJobCreated <- liftIO getCurrentTime