diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 502f3d09f..a2b93a00d 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -145,6 +145,7 @@ MenuLdap: LDAP Schnittstelle MenuApc: Druckerei MenuPrintSend: Manueller Briefversand MenuPrintDownload: Brief herunterladen +MenuPrintLog: LPR Schnittstelle MenuApiDocs: API-Dokumentation (Englisch) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 9fcb4b2a6..6fe895c22 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -145,6 +145,7 @@ MenuLdap: LDAP Interface MenuApc: Printing MenuPrintSend: Send Letter MenuPrintDownload: Download Letter +MenuPrintLog: LPR Interface MenuApiDocs: API documentation MenuSwagger: OpenAPI 2.0 (Swagger) diff --git a/routes b/routes index 3f30c960a..752405690 100644 --- a/routes +++ b/routes @@ -82,6 +82,7 @@ /print/acknowledge/direct PrintAckDirectR POST !system-printer /print/send PrintSendR GET POST /print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer +/print/log PrintLogR GET !system-printer /health HealthR GET !free /instance InstanceR GET !free diff --git a/src/Audit.hs b/src/Audit.hs index 0e93fc9e7..f26af2d80 100644 --- a/src/Audit.hs +++ b/src/Audit.hs @@ -128,7 +128,7 @@ logInterface :: ( AuthId (HandlerSite m) ~ Key User -> Text -- ^ Any additional information -> ReaderT (YesodPersistBackend (HandlerSite m)) m () -- ^ Log a transaction using information available from `HandlerT`, also calls `audit` -logInterface interfaceLogInterface interfaceLogSubtype interfaceLogSuccess interfaceLogRows interfaceLogInfo = do +logInterface (Text.strip -> interfaceLogInterface) (Text.strip -> interfaceLogSubtype) interfaceLogSuccess interfaceLogRows (Text.strip -> interfaceLogInfo) = do interfaceLogTime <- liftIO getCurrentTime interfaceLogWrite <- (methodGet /=) . Wai.requestMethod . reqWaiRequest <$> getRequest deleteBy $ UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite -- always replace, deleteBy & insert seems to be safest and fastest diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index ce7d466f4..374b4d566 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -134,6 +134,7 @@ breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenter breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed +breadcrumb PrintLogR = i18nCrumb MsgMenuPrintLog $ Just PrintCenterR breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR breadcrumb (SchoolR ssh sRoute) = case sRoute of @@ -2435,8 +2436,18 @@ pageActions PrintCenterR = do , navForceActive = False } } + printLog = NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuPrintLog + , navRoute = PrintLogR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } dayLinks <- mapM toDayAck $ Map.toAscList dayMap - return $ manualSend : take 9 dayLinks + return $ manualSend : printLog : take 9 dayLinks pageActions AdminCrontabR = return [ NavPageActionPrimary diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index fbaf5df6e..92dcac020 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -287,7 +287,8 @@ mkInterfaceLogTable flagError cutOffOldTime = do , sortable (Just "time") (i18nCell MsgInterfaceLastSynch ) $ dateTimeCell . view (resultILog . _interfaceLogTime) , sortable (Just "rows") (i18nCell MsgTableRows ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows) , sortable Nothing (textCell "Info" ) $ \(view resultILog -> ilt) -> case ilt of - InterfaceLog "AVS" "Synch" True _ _ i _ -> anchorCell ProblemAvsErrorR $ toWgt i + InterfaceLog "AVS" "Synch" True _ _ i _ -> anchorCell ProblemAvsErrorR $ toWgt $ bool i "AVS-Log" $ null i + InterfaceLog "LPR" _ _ _ _ i _ -> anchorCell PrintLogR $ toWgt $ bool i "LPR-Log" $ null i InterfaceLog _ _ _ _ _ i _ -> textCell i ] dbtSorting = mconcat diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 3fdd24b35..bdc6e4572 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -485,37 +485,42 @@ getPrintLogR = do resultTrans :: Lens' (DBRow (TransactionLog, Aeson.Result Transaction)) (Aeson.Result Transaction) resultTrans = _dbrOutput . _2 + 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 + tCellErr = tCell' stringCell + tCell = tCell' $ const mempty + dbtIdent = "lpr-log" :: Text dbtSQLQuery l = do E.where_ $ E.val "LPR" E.==. l E.^. TransactionLogInfo E.->>. "interface-name" + -- E.&&. E.val "interface" E.==. l E.^. TransactionLogInfo E.->>. "transaction" -- not necessary return l dbtRowKey = (E.^. TransactionLogId) 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 - , sortable Nothing (textCell "Status") $ \(view resultTrans -> jt) -> - case jt of - (Aeson.Error _) -> mempty - (Aeson.Success t) -> cellMaybe iconBoolCell $ transactionInterfaceSuccess t - , sortable Nothing (i18nCell MsgSystemMessageContent) $ \(view resultTrans -> jt) -> - case jt of - (Aeson.Error msg) -> stringCell msg - (Aeson.Success t) -> textCell $ transactionInterfaceInfo t + [ sortable (Just "time") (i18nCell MsgSystemMessageTimestamp) $ \(view $ resultLog . to transactionLogTime -> t) -> dateTimeCell t + , sortable (Just "status") (textCell "Status") $ tCell (cellMaybe iconBoolCell . transactionInterfaceSuccess) + , sortable (Just "subtype") (i18nCell MsgInterfaceSubtype) $ tCell ( textCell . transactionInterfaceSubtype) + , sortable (Just "info") (i18nCell MsgSystemMessageContent) $ tCellErr ( textCell . transactionInterfaceInfo) ] dbtSorting = mconcat - [ singletonMap "time" $ SortColumn (E.^. TransactionLogTime) + [ singletonMap "time" $ SortColumn (E.^. TransactionLogTime) + , singletonMap "status" $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-success") + , singletonMap "subtype" $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-subtype") + , singletonMap "info" $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-info" ) ] - dbtFilter = mempty + dbtFilter = mempty dbtFilterUI = mempty - dbtStyle = def + dbtStyle = def dbtParams = def dbtCsvEncode = noCsvEncode dbtCsvDecode = Nothing dbtExtraReps = [] validator = def & defaultSorting [ SortDescBy "time" ] tbl <- runDB $ dbTableDB' validator logDBTable - siteLayoutMsg MsgMenuApc $ do - setTitleI MsgMenuApc + siteLayoutMsg MsgMenuPrintLog $ do + setTitleI MsgMenuPrintLog [whamlet|^{tbl}|]