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

chore(log): lpr log page made accessible

Browse Source
This commit is contained in:
Steffen Jost 2024-01-31 12:43:12 +01:00
parent fd388b91f4
commit 798a07e36c
7 changed files with 37 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -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)

1
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -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)

1
routes
View File

@ -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

2
src/Audit.hs
View File

@ -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

13
src/Foundation/Navigation.hs
View File

@ -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

3
src/Handler/Admin.hs
View File

@ -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

33
src/Handler/PrintCenter.hs
View File

@ -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}|]