diff --git a/src/Jobs/Handler/Print.hs b/src/Jobs/Handler/Print.hs new file mode 100644 index 000000000..4c97d3f0d --- /dev/null +++ b/src/Jobs/Handler/Print.hs @@ -0,0 +1,60 @@ +-- SPDX-FileCopyrightText: 2023 Steffen Jost +-- +-- 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 = 32 + +-- needed, since JobPrintAck cannot requeue itself due to JobNoQueueSame (and having no parameters) +dispatchJobPrintAckAgain :: JobHandler UniWorX +dispatchJobPrintAckAgain = JobHandlerException act + where + act = do + liftIO $ threadDelay 3e6 -- wait 3s before continuing + void $ queueJob JobPrintAck + +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