chore(letter): implement print center acknowledging list

This commit is contained in:
Steffen Jost 2022-07-15 17:45:40 +02:00
parent ea2873476b
commit efc13f4498
13 changed files with 82 additions and 45 deletions

View File

@ -1,9 +1,11 @@
PJActAcknowledge: Druck und Versand bestätigen PJActAcknowledge: Druck und Versand bestätigen
PrintJobName: Dummy TODO EN PrintJobName: Bezeichnung
PrintJobId: Dummy TODO EN PrintJobId !ident-ok: Id
PrintJobCreated: Dummy TODO EN PrintJobCreated: Gesendet
PrintJobAcknowledged: Dummy TODO EN PrintJobAcknowledged: Bestätigt
PrintRecipient: Dummy TODO EN PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt
PrintSender: Dummy TODO EN PrintRecipient: Empfänger
PrintCourse: Dummy TODO EN PrintSender !ident-ok: Sender
PrintQualification: Dummy TODO EN PrintCourse: Kurse
PrintQualification: Qualifikation
PrintPDF !ident-ok: pdf

View File

@ -1,9 +1,11 @@
PJActAcknowledge: Acknowledge printing and mailing PJActAcknowledge: Acknowledge printing and mailing
PrintJobName: Dummy TODO DE PrintJobName: Description
PrintJobId: Dummy TODO DE PrintJobId: Id
PrintJobCreated: Dummy TODO DE PrintJobCreated: Created
PrintJobAcknowledged: Dummy TODO DE PrintJobAcknowledged: Acknowledged
PrintRecipient: Dummy TODO DE PrintJobAcknowledge n@Int64: #{n} #{pluralENs n "print-job"} marked as printed and mailed
PrintSender: Dummy TODO DE PrintRecipient: Recipient
PrintCourse: Dummy TODO DE PrintSender: Sender
PrintQualification: Dummy TODO DE PrintCourse: Course
PrintQualification: Qualification
PrintPDF: pdf

View File

@ -56,8 +56,8 @@ MppOpening: Anrede
MppClosing: Grußformel MppClosing: Grußformel
MppDate: Datum MppDate: Datum
MppURL: Link Prüfung MppURL: Link Prüfung
MppLogin: LOGIN MppLogin !ident-ok: Login
MppPin: PIN MppPin !ident-ok: Pin
MppRecipient: Empfänger MppRecipient: Empfänger
MppAddress: Adresse MppAddress: Adresse
MppLang: Sprache MppLang: Sprache

View File

@ -135,6 +135,7 @@ MenuLmsDirect: Direkter Upload
MenuAvs: Schnittstelle AVS MenuAvs: Schnittstelle AVS
MenuApc: Druckerei MenuApc: Druckerei
MenuPrintSend: Manueller Briefversand MenuPrintSend: Manueller Briefversand
MenuPrintDownload: Brief herunterladen
MenuApiDocs: API-Dokumentation (Englisch) MenuApiDocs: API-Dokumentation (Englisch)
MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)

View File

@ -45,7 +45,7 @@ MenuMessageList: System messages
MenuAdminErrMsg: Decrypt error message MenuAdminErrMsg: Decrypt error message
MenuAdminTokens: Issue tokens MenuAdminTokens: Issue tokens
MenuProfileData: Personal information MenuProfileData: Personal information
MenuTermCreate: Create new semester MenuTermCreate: Create new semester
MenuCourseNew: Create new course MenuCourseNew: Create new course
MenuTermEdit: Edit semester MenuTermEdit: Edit semester
MenuTermCurrent: Current semester MenuTermCurrent: Current semester
@ -128,7 +128,7 @@ MenuQualifications: Qualifcations
MenuLms: E-Learning MenuLms: E-Learning
MenuLmsEdit: Edit E-Learning MenuLmsEdit: Edit E-Learning
MenuLmsUsers: Download E-Learning Users MenuLmsUsers: Download E-Learning Users
MenuLmsUserlist: Upload E-Learning Users MenuLmsUserlist: Upload E-Learning Users
MenuLmsResult: Upload E-Learning Results MenuLmsResult: Upload E-Learning Results
MenuLmsUpload: Upload MenuLmsUpload: Upload
MenuLmsDirect: Direct Upload MenuLmsDirect: Direct Upload
@ -136,6 +136,7 @@ MenuLmsDirect: Direct Upload
MenuAvs: AVS Interface MenuAvs: AVS Interface
MenuApc: Printing MenuApc: Printing
MenuPrintSend: Send Letter MenuPrintSend: Send Letter
MenuPrintDownload: Download Letter
MenuApiDocs: API documentation MenuApiDocs: API documentation
MenuSwagger: OpenAPI 2.0 (Swagger) MenuSwagger: OpenAPI 2.0 (Swagger)

View File

@ -1,6 +1,7 @@
PrintJob PrintJob
name Text name Text
file FileContentReference filename FilePath
file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe
created UTCTime created UTCTime
acknowledged UTCTime Maybe acknowledged UTCTime Maybe
recipient UserId Maybe -- optional as some letters may contain just an address recipient UserId Maybe -- optional as some letters may contain just an address

1
routes
View File

@ -63,6 +63,7 @@
/print PrintCenterR GET POST /print PrintCenterR GET POST
/print/send PrintSendR GET POST /print/send PrintSendR GET POST
/print/download/#CryptoUUIDPrintJob PrintDownloadR GET
/health HealthR GET !free /health HealthR GET !free
/instance InstanceR GET !free /instance InstanceR GET !free

View File

@ -56,6 +56,7 @@ decCryptoIDs [ ''SubmissionId
, ''ExternalExamId , ''ExternalExamId
, ''MaterialFileId , ''MaterialFileId
, ''AllocationMatchingId , ''AllocationMatchingId
, ''PrintJobId
] ]
decCryptoIDKeySize decCryptoIDKeySize

View File

@ -106,8 +106,9 @@ breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR
breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing
breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR
breadcrumb (PrintDownloadR _) = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
breadcrumb (SchoolR ssh sRoute) = case sRoute of breadcrumb (SchoolR ssh sRoute) = case sRoute of

View File

@ -369,7 +369,7 @@ postLmsR sid qsh = do
forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do
when (isRenewPinAct action) $ do when (isRenewPinAct action) $ do
newPin <- liftIO randomLMSpw newPin <- liftIO randomLMSpw
update lid [LmsUserPin =. newPin, LmsUserDatePin =. now] -- must be within its own runDB update lid [LmsUserPin =. newPin, LmsUserDatePin =. now]
when (isNotifyAct action) $ when (isNotifyAct action) $
queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' } queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' }
return $ length okUsers return $ length okUsers

View File

@ -3,21 +3,23 @@
module Handler.PrintCenter module Handler.PrintCenter
( getPrintCenterR, postPrintCenterR ( getPrintCenterR, postPrintCenterR
, getPrintSendR , postPrintSendR , getPrintSendR , postPrintSendR
, getPrintDownloadR
-- TODO: for testing only, remove exports -- TODO: for testing only, remove exports
, mprToMeta , mprToMeta
) where ) where
import Import import Import
--import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy as LT
import qualified Data.ByteString.Lazy as LBS -- import qualified Data.ByteString.Lazy as LBS
import qualified Text.Pandoc as P import qualified Text.Pandoc as P
import qualified Text.Pandoc.Builder as P import qualified Text.Pandoc.Builder as P
import Database.Persist.Sql (updateWhereCount)
import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH import Database.Esqueleto.Utils.TH
@ -181,20 +183,21 @@ mkPJTable = do
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat dbtColonnade = mconcat
[ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^? resultPrintJob . _entityVal . _printJobAcknowledged) [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^? resultPrintJob . _entityVal . _printJobAcknowledged)
, sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n , sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
, sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow k) , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow k)
, sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t , 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-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
, sortable (toNothingS "pdf") (i18nCell MsgPrintPDF) $ \( view $ resultPrintJob . _entityKey -> k) -> anchorCellM (PrintDownloadR <$> encrypt k) (text2widget "pdf")
, sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
, sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
, sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell
, sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell , sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) [ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName))
, single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId)) , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId))
, single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) , single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
, single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) , single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
, single ("pj-recipient" , sortUserNameBareM queryRecipient) , single ("pj-recipient" , sortUserNameBareM queryRecipient)
, single ("pj-sender" , sortUserNameBareM querySender ) , single ("pj-sender" , sortUserNameBareM querySender )
, single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName)) , single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName))
@ -243,18 +246,23 @@ mkPJTable = do
getPrintCenterR, postPrintCenterR :: Handler Html getPrintCenterR, postPrintCenterR :: Handler Html
getPrintCenterR = postPrintCenterR getPrintCenterR = postPrintCenterR
postPrintCenterR = do postPrintCenterR = do
_currentRoute <- fromMaybe (error "printCenterR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler currentRoute <- fromMaybe (error "printCenterR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
(_pjRes, _pjTable) <- runDB mkPJTable (pjRes, pjTable) <- runDB mkPJTable
-- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
-- TODO: continue here formResult pjRes $ \case
-- formResult pjRes $ \case (PJActAcknowledgeData, pjIds) -> do
-- (PJActAcknowledgeData, pjIds) -> error "continue here" let setPJIds = Set.toList pjIds
now <- liftIO getCurrentTime
num <- runDB $ updateWhereCount [PrintJobAcknowledged ==. Nothing, PrintJobId <-. setPJIds] [PrintJobAcknowledged =. Just now]
addMessageI Success $ MsgPrintJobAcknowledge num
redirect currentRoute
siteLayoutMsg MsgMenuApc $ do siteLayoutMsg MsgMenuApc $ do
setTitleI MsgMenuApc setTitleI MsgMenuApc
$(widgetFile "print-center") $(widgetFile "print-center")
getPrintSendR, postPrintSendR:: Handler Html getPrintSendR, postPrintSendR :: Handler Html
getPrintSendR = postPrintSendR getPrintSendR = postPrintSendR
postPrintSendR = do postPrintSendR = do
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm Nothing ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm Nothing
@ -264,8 +272,11 @@ postPrintSendR = do
-- now <- liftIO getCurrentTime -- now <- liftIO getCurrentTime
case e_pdf of case e_pdf of
Right bs -> do Right bs -> do
liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf" -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
uID <- maybeAuthId
filepath <- runDB $ sendLetter "Test-Brief" bs Nothing uID Nothing Nothing
addMessage Success $ toHtml $ "Druckauftrag angelegt für " <> filepath
Left err -> addMessage Error . toHtml $ P.renderError err Left err -> addMessage Error . toHtml $ P.renderError err
-- TODO: continue here with acutal letter sending! -- TODO: continue here with acutal letter sending!
return $ Just () return $ Just ()
@ -279,3 +290,20 @@ postPrintSendR = do
} }
-- TODO: use i18nWidgetFile instead if this is to become permanent -- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "print-send") $(widgetFile "print-send")
getPrintDownloadR :: CryptoUUIDPrintJob -> Handler TypedContent
getPrintDownloadR cupj = do
pjId <- decrypt cupj
PrintJob {..} <- runDB $ get404 pjId
sendByteStringAsFile printJobFilename printJobFile printJobCreated
{- for PrintJobFile :: FileContentReference use this code, however, requires instances
HasFileReference PrintJob and IsFileReference PrintJob which seemed to complicated... :(
serveOneFile $ fileQuery .| C.map entityVal
where
fileQuery = E.selectSource $ E.from $
\pj -> do
-- filter to requested file
E.where_ (pj E.^. PrintJobId E.==. E.val pjId)
-- return file entity
return pj
-}

View File

@ -296,4 +296,3 @@ instance IsFileReference MaterialFile where
fileReferenceTitleField = MaterialFileTitle fileReferenceTitleField = MaterialFileTitle
fileReferenceContentField = MaterialFileContent fileReferenceContentField = MaterialFileContent
fileReferenceModifiedField = MaterialFileModified fileReferenceModifiedField = MaterialFileModified

View File

@ -1,3 +1,3 @@
<section> <section>
<p> <p>
Hier soll bald eine Tabelle mit allen Druckaufträgen einsehbar sein. ^{pjTable}