chore(log): lpr log page made accessible

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)

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)

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

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

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

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

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 (Just "time")    (i18nCell MsgSystemMessageTimestamp) $ \(view $ resultLog . to transactionLogTime -> t) -> dateTimeCell t
-          , sortable Nothing (textCell "Status") $ \(view resultTrans -> jt) ->
+          , sortable (Just "status")  (textCell "Status")                $ tCell    (cellMaybe iconBoolCell . transactionInterfaceSuccess)
-              case jt of
+          , sortable (Just "subtype") (i18nCell MsgInterfaceSubtype)     $ tCell    (              textCell . transactionInterfaceSubtype)
-                (Aeson.Error   _) -> mempty
+          , sortable (Just "info")    (i18nCell MsgSystemMessageContent) $ tCellErr (              textCell . transactionInterfaceInfo)
-                (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
           ]
         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 
+  siteLayoutMsg MsgMenuPrintLog $ do 
-    setTitleI MsgMenuApc
+    setTitleI MsgMenuPrintLog
     [whamlet|^{tbl}|]