61 lines
2.8 KiB
Haskell
61 lines
2.8 KiB
Haskell
-- SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Jobs.Handler.Print
|
|
( dispatchJobPrintAck
|
|
, dispatchJobPrintAckAgain
|
|
) where
|
|
|
|
import Import
|
|
import Jobs.Queue
|
|
|
|
-- import Jobs.Handler.Intervals.Utils
|
|
import qualified Data.Text as Text
|
|
-- import UnliftIO.Concurrent (threadDelay)
|
|
|
|
-- import Database.Persist.Sql (deleteWhereCount)
|
|
-- import Database.Esqueleto.Experimental ((:&)(..))
|
|
-- import qualified Database.Esqueleto.Experimental as E
|
|
-- import qualified Database.Esqueleto.Legacy as E
|
|
-- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant
|
|
-- import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
jobPrintAckChunkSize :: Int
|
|
jobPrintAckChunkSize = 64
|
|
|
|
-- needed, since JobPrintAck cannot requeue itself due to JobNoQueueSame (and having no parameters)
|
|
dispatchJobPrintAckAgain :: JobHandler UniWorX
|
|
dispatchJobPrintAckAgain = JobHandlerException act
|
|
where
|
|
act = void $ queueJob JobPrintAck
|
|
-- liftIO $ threadDelay 3e6 -- wait 3s before continuing UPDATE: no wait needed
|
|
|
|
|
|
dispatchJobPrintAck :: JobHandler UniWorX
|
|
dispatchJobPrintAck = JobHandlerException act
|
|
where
|
|
act = do
|
|
moretodo <- runDB $ do
|
|
aliases <- selectList [] [Desc PrintAckIdAliasPriority]
|
|
let ftransAliases = id : fmap (\Entity{entityVal=PrintAckIdAlias{printAckIdAliasNeedle=n, printAckIdAliasReplacement=r}} -> Text.replace n r) aliases
|
|
ackOneId ackt apci = selectKeysList [PrintJobApcIdent ==. apci, PrintJobAcknowledged ==. Nothing] [Asc PrintJobCreated, LimitTo 1] >>= \case
|
|
[pjid] -> update pjid [PrintJobAcknowledged =. Just ackt] >>
|
|
return True
|
|
_ -> return False
|
|
procOneId oks Entity{entityKey=paid, entityVal=PrintAcknowledge{printAcknowledgeApcIdent=Text.strip -> apci, printAcknowledgeTimestamp=ackt}} =
|
|
andM [ackOneId ackt $ ftrans apci | ftrans <- ftransAliases] >>= \case
|
|
True -> delete paid >> return (succ oks)
|
|
False -> update paid [PrintAcknowledgeProcessed =. True] >> return oks
|
|
apcis <- selectList [PrintAcknowledgeProcessed ==. False] [Asc PrintAcknowledgeTimestamp, LimitTo jobPrintAckChunkSize]
|
|
oks <- foldM procOneId 0 apcis
|
|
let nr_apcis = length apcis
|
|
if nr_apcis == oks
|
|
then $logInfoS "APC" $ "Success: " <> tshow oks <> " print jobs were acknowledged as printed."
|
|
else $logErrorS "APC" $ "Error: Only " <> tshow oks <> " out of " <> tshow nr_apcis <> " print jobs could be acknowledged as printed."
|
|
return $ nr_apcis >= jobPrintAckChunkSize
|
|
when moretodo $ void $ queueJob JobPrintAckAgain
|