This commit is contained in:
Evgeny Poberezkin
2024-10-23 10:28:46 +01:00
parent 9807ef2b0c
commit b7624a0d04
+12 -7
View File
@@ -1757,16 +1757,20 @@ processServerMessages = do
AMS SMSJournal ms -> case old_ of
Just old -> do
logInfo "expiring journal store messages..."
(storedMsgsCount, expiredMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processExpireQueue old) (0, 0, 0)
pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues}
withAllMsgQueues ms (\_ -> processExpireQueue old) newMessageStats
Nothing -> do
logInfo "validating journal store messages..."
(storedMsgsCount, storedQueues) <- withAllMsgQueues ms (\_ -> processValidateQueue) (0, 0)
pure MessageStats {storedMsgsCount, expiredMsgsCount = 0, storedQueues}
withAllMsgQueues ms (\_ -> processValidateQueue) newMessageStats
where
processExpireQueue old q (!stored, !expired, !qCount) =
processExpireQueue old q MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues} =
runExceptT expireQueue >>= \case
Right (stored', expired') -> pure (stored + stored', expired + expired', qCount + 1)
Right (stored', expired') ->
pure
MessageStats
{ storedMsgsCount = storedMsgsCount + stored',
expiredMsgsCount = expiredMsgsCount + expired',
storedQueues = storedQueues + 1
}
Left e -> do
logInfo $ "failed expiring messages in queue " <> T.pack (queueDirectory $ queue q) <> ": " <> tshow e
exitFailure
@@ -1777,7 +1781,8 @@ processServerMessages = do
liftIO $ logQueueState q
liftIO $ closeMsgQueue q
pure (stored'', expired'')
processValidateQueue q (!stored, !qCount) = getQueueSize q >>= \stored' -> pure (stored + stored', qCount + 1)
processValidateQueue q stats@MessageStats {storedMsgsCount, storedQueues} =
getQueueSize q >>= \stored' -> pure stats {storedMsgsCount = storedMsgsCount + stored', storedQueues = storedQueues + 1}
importMessages :: forall s. MsgStoreClass s => s -> FilePath -> Maybe Int64 -> IO MessageStats
importMessages ms f old_ = do