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

chore(apc): fix acknowledging mechanism after tests

Browse Source
This commit is contained in:
Steffen Jost 2023-03-22 15:01:33 +00:00
parent 81a30fadc4
commit 326ca71875
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Handler/PrintCenter.hs
View File

@ -30,8 +30,8 @@ import Utils.Print
-- import qualified Data.Set as Set -- import qualified Data.Set as Set
import Handler.Utils import Handler.Utils
import Handler.Utils.Csv -- import Handler.Utils.Csv
import qualified Data.Csv as Csv -- import qualified Data.Csv as Csv
-- avoids repetition of local definitions -- avoids repetition of local definitions
single :: (k,a) -> Map k a single :: (k,a) -> Map k a
@ -374,10 +374,10 @@ postPrintAckR ackDay numAck chksm = do
-- no header csv, containing a single column of lms identifiers (logins) -- no header csv, containing a single column of lms identifiers (logins)
-- instance Csv.FromRecord LmsIdent -- default suffices -- instance Csv.FromRecord LmsIdent -- default suffices
instance Csv.FromRecord Text where -- instance Csv.FromRecord Text where
parseRecord v -- parseRecord v
| length v == 1 = v Csv..! 1 -- | length v >= 1 = v Csv..! 0
| otherwise = mzero -- | otherwise = pure "ERROR"
postPrintAckDirectR :: Handler Html postPrintAckDirectR :: Handler Html
postPrintAckDirectR = do postPrintAckDirectR = do
@ -386,7 +386,9 @@ postPrintAckDirectR = do
[(fhead,file)] -> do [(fhead,file)] -> do
runDB $ do runDB $ do
enr <- try $ runConduit $ fileSource file enr <- try $ runConduit $ fileSource file
.| decodeCsvPositional Csv.NoHeader -- .| decodeCsvPositional Csv.NoHeader -- decode by separator position
.| decodeUtf8C -- no CSV, just convert each line to a single text
.| linesUnboundedC
.| sinkList .| sinkList
case enr of case enr of
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
@ -398,7 +400,7 @@ postPrintAckDirectR = do
nrApcIds <- updateWhereCount nrApcIds <- updateWhereCount
[PrintJobAcknowledged ==. Nothing, PrintJobApcIdent <-. reqIds] [PrintJobAcknowledged ==. Nothing, PrintJobApcIdent <-. reqIds]
[PrintJobAcknowledged =. Just now] [PrintJobAcknowledged =. Just now]
nrOk <- if nrApcIds > 0 && nrReq > 0 nrOk <- if nrApcIds <= 0 && nrReq > 0
then updateWhereCount -- for downwards compatibility only then updateWhereCount -- for downwards compatibility only
[PrintJobAcknowledged ==. Nothing, PrintJobLmsUser <-. (Just . LmsIdent . dropPrefixText "lms-" <$> reqIds)] [PrintJobAcknowledged ==. Nothing, PrintJobLmsUser <-. (Just . LmsIdent . dropPrefixText "lms-" <$> reqIds)]
[PrintJobAcknowledged =. Just now] [PrintJobAcknowledged =. Just now]
@ -412,8 +414,9 @@ postPrintAckDirectR = do
$logInfoS "APC" msg $logInfoS "APC" msg
return (ok200, msg) return (ok200, msg)
| otherwise -> do | otherwise -> do
forM_ reqIds $ \t -> $logInfoS "APC" $ "Received APC Identifier: \"" <> t <> "\""
let msg = "Warning: Only " <> tshow nrOk <> " print jobs out of " <> tshow nrReq <> " were acknowledged as printed, for file " <> fhead let msg = "Warning: Only " <> tshow nrOk <> " print jobs out of " <> tshow nrReq <> " were acknowledged as printed, for file " <> fhead
$logWarnS "APC" msg $logWarnS "APC" msg
return (ok200, msg) return (ok200, msg)
[] -> do [] -> do
let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging." let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging."