chore(lpr): add manual print-ack csv upload
This commit is contained in:
parent
47f853bd4a
commit
6d44f36e2a
@ -147,6 +147,7 @@ MenuApc: Druckerei
|
||||
MenuPrintSend: Manueller Briefversand
|
||||
MenuPrintDownload: Brief herunterladen
|
||||
MenuPrintLog: LPR Schnittstelle
|
||||
MenuPrintAck: Druckbestätigung
|
||||
|
||||
MenuApiDocs: API-Dokumentation (Englisch)
|
||||
MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)
|
||||
|
||||
@ -147,6 +147,7 @@ MenuApc: Printing
|
||||
MenuPrintSend: Send Letter
|
||||
MenuPrintDownload: Download Letter
|
||||
MenuPrintLog: LPR Interface
|
||||
MenuPrintAck: Acknowledge Printing
|
||||
|
||||
MenuApiDocs: API documentation
|
||||
MenuSwagger: OpenAPI 2.0 (Swagger)
|
||||
|
||||
2
routes
2
routes
@ -79,7 +79,7 @@
|
||||
|
||||
/print PrintCenterR GET POST !system-printer
|
||||
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer
|
||||
/print/acknowledge/direct PrintAckDirectR POST !system-printer
|
||||
/print/acknowledge/direct PrintAckDirectR GET POST !system-printer
|
||||
/print/send PrintSendR GET POST
|
||||
/print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer
|
||||
/print/log PrintLogR GET !system-printer
|
||||
|
||||
@ -127,13 +127,13 @@ breadcrumb FirmAllR = i18nCrumb MsgMenuFirms Nothing
|
||||
breadcrumb FirmsCommR{} = i18nCrumb MsgMenuFirmsComm $ Just FirmAllR
|
||||
breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAllR
|
||||
breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh
|
||||
breadcrumb (FirmCommR fsh)= i18nCrumb MsgMenuFirmsComm $ Just $ FirmUsersR fsh
|
||||
breadcrumb (FirmCommR fsh)= i18nCrumb MsgMenuFirmsComm $ Just $ FirmUsersR fsh
|
||||
|
||||
breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing
|
||||
breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR
|
||||
breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR
|
||||
breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed
|
||||
breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed
|
||||
breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck $ Just PrintCenterR
|
||||
breadcrumb PrintLogR = i18nCrumb MsgMenuPrintLog $ Just PrintCenterR
|
||||
|
||||
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
|
||||
@ -193,7 +193,7 @@ breadcrumb (LmsLearnersDirectR ssh qsh) = i18nCrumb MsgMenuLmsLearners $ Jus
|
||||
breadcrumb (LmsReportR ssh qsh) = i18nCrumb MsgMenuLmsReport $ Just $ LmsR ssh qsh
|
||||
breadcrumb (LmsReportUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsReportR ssh qsh
|
||||
breadcrumb (LmsReportDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsReportR ssh qsh -- never displayed
|
||||
--
|
||||
--
|
||||
breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect
|
||||
breadcrumb (LmsUserR ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserSchoolR u ssh
|
||||
breadcrumb (LmsUserSchoolR u _ ) = i18nCrumb MsgMenuLmsUserSchool $ Just $ LmsUserAllR u
|
||||
@ -294,7 +294,7 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
|
||||
TUsersR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
|
||||
guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
|
||||
return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
|
||||
TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
@ -2380,7 +2380,7 @@ pageActions (LmsR sid qsh) = return
|
||||
[ defNavLink MsgMenuLmsUpload $ LmsReportUploadR sid qsh
|
||||
, defNavLink MsgMenuLmsDirectUpload $ LmsReportDirectR sid qsh
|
||||
]
|
||||
}
|
||||
}
|
||||
, NavPageActionSecondary {
|
||||
navLink = defNavLink MsgMenuLmsEdit $ LmsEditR sid qsh
|
||||
}
|
||||
@ -2405,7 +2405,7 @@ pageActions (FirmUsersR fsh) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
|
||||
, navChildren = []
|
||||
}
|
||||
}
|
||||
]
|
||||
pageActions (FirmSupersR fsh) = return
|
||||
[ NavPageActionPrimary
|
||||
@ -2458,10 +2458,20 @@ pageActions PrintCenterR = do
|
||||
, navForceActive = False
|
||||
}
|
||||
}
|
||||
printAck = NavPageActionSecondary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuPrintAck
|
||||
, navRoute = PrintAckDirectR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
}
|
||||
dayLinks <- mapM toDayAck $ Map.toAscList dayMap
|
||||
return $ manualSend : printLog : take 9 dayLinks
|
||||
return $ manualSend : printLog : printAck : take 9 dayLinks
|
||||
|
||||
pageActions AdminCrontabR = return
|
||||
pageActions AdminCrontabR = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuAdminJobs AdminJobsR
|
||||
, navChildren = []
|
||||
|
||||
@ -7,10 +7,10 @@
|
||||
|
||||
module Handler.PrintCenter
|
||||
( getPrintDownloadR
|
||||
, getPrintCenterR, postPrintCenterR
|
||||
, getPrintCenterR, postPrintCenterR
|
||||
, getPrintSendR , postPrintSendR
|
||||
, getPrintAckR , postPrintAckR
|
||||
, postPrintAckDirectR
|
||||
, getPrintAckDirectR, postPrintAckDirectR
|
||||
, getPrintLogR
|
||||
) where
|
||||
|
||||
@ -44,11 +44,11 @@ single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
|
||||
data LRQF = LRQF
|
||||
{ lrqfLetter :: Text
|
||||
data LRQF = LRQF
|
||||
{ lrqfLetter :: Text
|
||||
, lrqfUser :: Either UserEmail UserId
|
||||
, lrqfSuper :: Maybe (Either UserEmail UserId)
|
||||
, lrqfQuali :: Entity Qualification
|
||||
, lrqfQuali :: Entity Qualification
|
||||
, lrqfIdent :: LmsIdent
|
||||
, lrqfPin :: Text
|
||||
, lrqfExpiry :: Maybe Day
|
||||
@ -63,12 +63,12 @@ makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRe
|
||||
<*> areq (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl)
|
||||
<*> aopt (userField False Nothing) (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl)
|
||||
<*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl)
|
||||
<*> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl)
|
||||
<*> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl)
|
||||
<*> areq textField (fslI MsgTableLmsPin) (lrqfPin <$> tmpl)
|
||||
<*> aopt dayField (fslI MsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl)
|
||||
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant)
|
||||
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant)
|
||||
(fslI MsgLmsRenewalReminder) (lrqfReminder <$> tmpl)
|
||||
where
|
||||
where
|
||||
lmsField = convertField LmsIdent getLmsIdent textField
|
||||
|
||||
validateLetterRenewQualificationF :: FormValidator LRQF Handler ()
|
||||
@ -77,12 +77,12 @@ validateLetterRenewQualificationF = -- do
|
||||
return ()
|
||||
|
||||
lrqf2letter :: LRQF -> DB (Entity User, SomeLetter)
|
||||
lrqf2letter LRQF{..}
|
||||
| lrqfLetter == "r" = do
|
||||
lrqf2letter LRQF{..}
|
||||
| lrqfLetter == "r" = do
|
||||
usr <- getUser lrqfUser
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
now <- liftIO getCurrentTime
|
||||
let letter = LetterRenewQualificationF
|
||||
let letter = LetterRenewQualificationF
|
||||
{ lmsLogin = lrqfIdent
|
||||
, lmsPin = lrqfPin
|
||||
, qualHolderID = usr ^. _entityKey
|
||||
@ -97,13 +97,13 @@ lrqf2letter LRQF{..}
|
||||
, isReminder = lrqfReminder
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| lrqfLetter == "e" || lrqfLetter == "E" = do
|
||||
| lrqfLetter == "e" || lrqfLetter == "E" = do
|
||||
rcvr <- mapM getUser lrqfSuper
|
||||
usr <- getUser lrqfUser
|
||||
usrShrt <- encrypt $ entityKey usr
|
||||
usrUuid <- encrypt $ entityKey usr
|
||||
urender <- liftHandler getUrlRender
|
||||
let letter = LetterExpireQualification
|
||||
let letter = LetterExpireQualification
|
||||
{ leqHolderCFN = usrShrt
|
||||
, leqHolderID = usr ^. _entityKey
|
||||
, leqHolderDN = usr ^. _userDisplayName
|
||||
@ -112,15 +112,15 @@ lrqf2letter LRQF{..}
|
||||
, leqId = lrqfQuali ^. _entityKey
|
||||
, leqName = lrqfQuali ^. _qualificationName . _CI
|
||||
, leqShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
, leqSchool = lrqfQuali ^. _qualificationSchool
|
||||
, leqSchool = lrqfQuali ^. _qualificationSchool
|
||||
, leqUrl = pure . urender $ ForProfileDataR usrUuid
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
| otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
|
||||
where
|
||||
where
|
||||
getUser :: Either UserEmail UserId -> DB (Entity User)
|
||||
getUser (Right uid) = getEntity404 uid
|
||||
getUser (Left mail) = getBy404 $ UniqueEmail mail
|
||||
getUser (Left mail) = getBy404 $ UniqueEmail mail
|
||||
|
||||
|
||||
data PJTableAction = PJActAcknowledge | PJActReprint
|
||||
@ -191,7 +191,7 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient
|
||||
return (printJob, recipient, sender, course, quali)
|
||||
|
||||
mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget)
|
||||
mkPJTable = do
|
||||
mkPJTable = do
|
||||
let
|
||||
dbtSQLQuery = pjTableQuery
|
||||
dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
|
||||
@ -226,7 +226,7 @@ mkPJTable = do
|
||||
dbtFilter = mconcat
|
||||
[ single ("name" , FilterColumn . E.mkContainsFilterWithCommaPlus id $ views (to queryPrintJob) (E.^. PrintJobName))
|
||||
, single ("apcid" , FilterColumn . E.mkContainsFilterWithComma id $ views (to queryPrintJob) (E.^. PrintJobApcIdent))
|
||||
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
|
||||
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
|
||||
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
|
||||
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
|
||||
, single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryRecipient) (E.?. UserDisplayName))
|
||||
@ -234,7 +234,7 @@ mkPJTable = do
|
||||
, single ("course" , FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryCourse) (E.?. CourseName))
|
||||
, single ("qualification", FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryQualification) (E.?. QualificationName))
|
||||
, single ("lmsid" , FilterColumn . E.mkContainsFilterWithCommaPlus (Just . LmsIdent) $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
|
||||
|
||||
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
@ -289,7 +289,7 @@ mkPJTable = do
|
||||
|
||||
getPrintCenterR, postPrintCenterR :: Handler Html
|
||||
getPrintCenterR = postPrintCenterR
|
||||
postPrintCenterR = do
|
||||
postPrintCenterR = do
|
||||
(pjRes, pjTable) <- runDB mkPJTable
|
||||
|
||||
formResult pjRes $ \case
|
||||
@ -299,21 +299,21 @@ postPrintCenterR = do
|
||||
addMessageI Success $ MsgPrintJobAcknowledge num
|
||||
reloadKeepGetParams PrintCenterR
|
||||
(PJActReprintData{ignoreReroute}, Set.toList -> pjIds) -> do
|
||||
let countOk = either (const $ Sum 0) (const $ Sum 1)
|
||||
let countOk = either (const $ Sum 0) (const $ Sum 1)
|
||||
oks <- runDB $ forM pjIds $ fmap countOk . reprintPDF (fromMaybe False ignoreReroute)
|
||||
let nr_oks = getSum $ mconcat oks
|
||||
nr_tot = length pjIds
|
||||
mstat = bool Warning Success $ nr_oks == nr_tot
|
||||
addMessageI mstat $ MsgPrintJobReprint nr_oks nr_tot
|
||||
reloadKeepGetParams PrintCenterR
|
||||
siteConf <- getYesod
|
||||
siteConf <- getYesod
|
||||
let lprConf = siteConf ^. _appLprConf
|
||||
reroute = siteConf ^. _appMailRerouteTo
|
||||
lprWgt = [whamlet|
|
||||
LPR Konfiguration ist #{lprQueue lprConf}@#{lprHost lprConf}:#{lprPort lprConf}
|
||||
<div>
|
||||
$maybe _ <- reroute
|
||||
Mail-reroute-to ist gesetzt, somit werden alle lpr Kommandos unterdrückt!
|
||||
Mail-reroute-to ist gesetzt, somit werden alle lpr Kommandos unterdrückt!
|
||||
|]
|
||||
siteLayoutMsg MsgMenuApc $ do
|
||||
setTitleI MsgMenuApc
|
||||
@ -323,7 +323,7 @@ postPrintCenterR = do
|
||||
getPrintSendR, postPrintSendR :: Handler Html
|
||||
getPrintSendR = postPrintSendR
|
||||
postPrintSendR = do
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
mbQual <- runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand]
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
@ -341,7 +341,7 @@ postPrintSendR = do
|
||||
def_lrqf = mkLetter <$> mbQual
|
||||
|
||||
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
|
||||
let procFormSend lrqf = case lrqfLetter lrqf of
|
||||
let procFormSend lrqf = case lrqfLetter lrqf of
|
||||
"E" -> (runDB (lrqf2letter lrqf) >>= printHtml (Just uid)) >>= \case
|
||||
Right html -> sendResponse $ toTypedContent html
|
||||
Left err -> do
|
||||
@ -349,7 +349,7 @@ postPrintSendR = do
|
||||
$logErrorS "LPR" msg
|
||||
addMessage Error $ toHtml msg
|
||||
pure ()
|
||||
_ -> do
|
||||
_ -> do
|
||||
ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
@ -400,26 +400,26 @@ postPrintAckR ackDay numAck chksm = do
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
formResult ackRes $ \BtnConfirm -> do
|
||||
numNew <- runDB $ do
|
||||
pjs <- Ex.select $ do
|
||||
numNew <- runDB $ do
|
||||
pjs <- Ex.select $ do
|
||||
pj <- Ex.from $ Ex.table @PrintJob
|
||||
let pjDay = E.day $ pj Ex.^. PrintJobCreated
|
||||
let pjDay = E.day $ pj Ex.^. PrintJobCreated
|
||||
Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
|
||||
Ex.&&. (pjDay Ex.==. Ex.val ackDay)
|
||||
Ex.&&. (pjDay Ex.==. Ex.val ackDay)
|
||||
return $ pj Ex.^. PrintJobId
|
||||
let changed = numAck /= length pjs || chksm /= hash (Set.fromList (Ex.unValue <$> pjs))
|
||||
if changed
|
||||
then return (-1)
|
||||
else do
|
||||
else do
|
||||
now <- liftIO getCurrentTime
|
||||
E.updateCount $ \pj -> do
|
||||
let pjDay = E.day $ pj E.^. PrintJobCreated
|
||||
let pjDay = E.day $ pj E.^. PrintJobCreated
|
||||
E.set pj [ PrintJobAcknowledged E.=. E.justVal now ]
|
||||
E.where_ $ E.isNothing (pj E.^. PrintJobAcknowledged)
|
||||
E.&&. (pjDay E.==. E.val ackDay)
|
||||
-- Ex.updateCount $ do
|
||||
-- pj <- Ex.from $ Ex.table @PrintJob
|
||||
-- let pjDay = E.day $ pj Ex.^. PrintJobCreated
|
||||
-- let pjDay = E.day $ pj Ex.^. PrintJobCreated
|
||||
-- Ex.set pj [ PrintJobAcknowledged Ex.=. Ex.just (Ex.val now) ]
|
||||
-- Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
|
||||
-- Ex.&&. (pjDay Ex.==. Ex.val ackDay)
|
||||
@ -428,29 +428,44 @@ postPrintAckR ackDay numAck chksm = do
|
||||
else addMessageI Error MsgPrintJobAcknowledgeFailed
|
||||
redirect PrintCenterR
|
||||
ackDayText <- formatTime SelFormatDate ackDay
|
||||
siteLayoutMsg
|
||||
(MsgPrintJobAcknowledgeQuestion numAck ackDayText)
|
||||
siteLayoutMsg
|
||||
(MsgPrintJobAcknowledgeQuestion numAck ackDayText)
|
||||
ackForm
|
||||
|
||||
-- no header csv, containing a single column of lms identifiers (logins)
|
||||
-- instance Csv.FromRecord LmsIdent -- default suffices
|
||||
-- instance Csv.FromRecord Text where
|
||||
-- parseRecord v
|
||||
-- instance Csv.FromRecord Text where
|
||||
-- parseRecord v
|
||||
-- | length v >= 1 = v Csv..! 0
|
||||
-- | otherwise = pure "ERROR"
|
||||
|
||||
saveApcident :: UTCTime -> Natural -> Text -> JobDB Natural
|
||||
saveApcident t i apci = insert_ (PrintAcknowledge apci t False) >> return (succ i)
|
||||
|
||||
|
||||
makeAckUploadForm :: Form FileInfo
|
||||
makeAckUploadForm = renderAForm FormStandard $ fileAFormReq "Acknowledge APC-Ident CSV"
|
||||
|
||||
getPrintAckDirectR :: Handler Html
|
||||
getPrintAckDirectR = do
|
||||
(widget, enctype) <- generateFormPost makeAckUploadForm
|
||||
siteLayoutMsg MsgMenuPrintAck $ do
|
||||
setTitleI MsgMenuPrintAck
|
||||
[whamlet|$newline never
|
||||
<form method=post enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
||||
|]
|
||||
|
||||
postPrintAckDirectR :: Handler Html
|
||||
postPrintAckDirectR = do
|
||||
now <- liftIO getCurrentTime
|
||||
(_params, files) <- runRequestBody
|
||||
(status, msg) <- case files of
|
||||
[(_fhead,file)] -> do
|
||||
runDBJobs $ do
|
||||
[(_fhead,file)] -> do
|
||||
runDBJobs $ do
|
||||
enr <- try $ runConduit $ fileSource file
|
||||
-- .| decodeCsvPositional Csv.NoHeader -- decode by separator position
|
||||
-- .| decodeCsvPositional Csv.NoHeader -- decode by separator position
|
||||
.| decodeUtf8C -- no CSV, just convert each line to a single text
|
||||
.| linesUnboundedC
|
||||
.| foldMC (saveApcident now) 0
|
||||
@ -462,7 +477,7 @@ postPrintAckDirectR = do
|
||||
let msg = "Success: received " <> tshow nr <> " APC identifiers to be processed later."
|
||||
$logInfoS "LMS" msg
|
||||
when (nr > 0) $ queueDBJob JobPrintAck
|
||||
return (ok200, msg)
|
||||
return (ok200, msg)
|
||||
[] -> do
|
||||
let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging."
|
||||
$logWarnS "APC" msg
|
||||
@ -476,7 +491,7 @@ postPrintAckDirectR = do
|
||||
|
||||
getPrintLogR :: Handler Html
|
||||
getPrintLogR = do
|
||||
let
|
||||
let
|
||||
logDBTable = DBTable{..}
|
||||
where
|
||||
resultLog :: Lens' (DBRow (TransactionLog, Aeson.Result Transaction)) TransactionLog
|
||||
@ -485,9 +500,9 @@ getPrintLogR = do
|
||||
resultTrans :: Lens' (DBRow (TransactionLog, Aeson.Result Transaction)) (Aeson.Result Transaction)
|
||||
resultTrans = _dbrOutput . _2
|
||||
|
||||
tCell' err c dbr = case view resultTrans dbr of
|
||||
tCell' err c dbr = case view resultTrans dbr of
|
||||
(Aeson.Error msg) -> err msg -- should not happen, due to query filter
|
||||
(Aeson.Success t) -> c t
|
||||
(Aeson.Success t) -> c t
|
||||
tCellErr = tCell' stringCell
|
||||
tCell = tCell' $ const mempty
|
||||
|
||||
@ -497,7 +512,7 @@ getPrintLogR = do
|
||||
-- E.&&. E.val "interface" E.==. l E.^. TransactionLogInfo E.->>. "transaction" -- not necessary
|
||||
return l
|
||||
dbtRowKey = (E.^. TransactionLogId)
|
||||
dbtProj = dbtProjSimple $ \(Entity _ l) -> do
|
||||
dbtProj = dbtProjSimple $ \(Entity _ l) -> do
|
||||
return (l, Aeson.fromJSON $ transactionLogInfo l)
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "time") (i18nCell MsgSystemMessageTimestamp) $ \(view $ resultLog . to transactionLogTime -> t) -> dateTimeCell t
|
||||
@ -521,6 +536,6 @@ getPrintLogR = do
|
||||
dbtExtraReps = []
|
||||
validator = def & defaultSorting [ SortDescBy "time" ]
|
||||
tbl <- runDB $ dbTableDB' validator logDBTable
|
||||
siteLayoutMsg MsgMenuPrintLog $ do
|
||||
siteLayoutMsg MsgMenuPrintLog $ do
|
||||
setTitleI MsgMenuPrintLog
|
||||
[whamlet|^{tbl}|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user