40 lines
1.7 KiB
Haskell
40 lines
1.7 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Jobs.Handler.TransactionLog
|
|
( dispatchJobTruncateTransactionLog
|
|
, dispatchJobDeleteTransactionLogIPs
|
|
) where
|
|
|
|
import Import hiding (currentYear)
|
|
import Handler.Utils.DateTime
|
|
|
|
import Database.Persist.Sql (updateWhereCount, deleteWhereCount)
|
|
|
|
dispatchJobTruncateTransactionLog, dispatchJobDeleteTransactionLogIPs :: JobHandler UniWorX
|
|
dispatchJobTruncateTransactionLog = JobHandlerAtomicWithFinalizer act fin
|
|
where
|
|
act = hoist lift $ do
|
|
now <- liftIO getCurrentTime
|
|
let localNow = utcToLocalTime now
|
|
(localCurrentYear, _, _) = toGregorian $ localDay localNow
|
|
localStartOfPreviousYear = LocalTime (fromGregorian (pred localCurrentYear) 1 1) midnight
|
|
(currentYear, _, _) = toGregorian $ utctDay now
|
|
startOfPreviousYear = UTCTime (fromGregorian (pred currentYear) 1 1) 0
|
|
startOfPreviousYear' = case localTimeToUTC localStartOfPreviousYear of
|
|
LTUUnique utc' _ -> utc'
|
|
_other -> startOfPreviousYear
|
|
|
|
deleteWhereCount [ TransactionLogTime <. startOfPreviousYear' ]
|
|
fin n = $logInfoS "TruncateTransactionLog" [st|Deleted #{n} transaction log entries|]
|
|
dispatchJobDeleteTransactionLogIPs = JobHandlerAtomicWithFinalizer act fin
|
|
where
|
|
act = hoist lift $ do
|
|
now <- liftIO getCurrentTime
|
|
retentionTime <- getsYesod $ view _appTransactionLogIPRetentionTime
|
|
let cutoff = addUTCTime (- retentionTime) now
|
|
|
|
updateWhereCount [ TransactionLogTime <. cutoff, TransactionLogRemote !=. Nothing ] [ TransactionLogRemote =. Nothing ]
|
|
fin n = $logInfoS "DeleteTransactionLogIPs" [st|Deleted #{n} IP entries from transaction log|]
|