32 lines
1.5 KiB
Haskell
32 lines
1.5 KiB
Haskell
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 = JobHandlerAtomic . 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
|
|
|
|
n <- deleteWhereCount [ TransactionLogTime <. startOfPreviousYear' ]
|
|
$logInfoS "TruncateTransactionLog" [st|Deleted #{n} transaction log entries|]
|
|
dispatchJobDeleteTransactionLogIPs = JobHandlerAtomic . hoist lift $ do
|
|
now <- liftIO getCurrentTime
|
|
retentionTime <- getsYesod $ view _appTransactionLogIPRetentionTime
|
|
let cutoff = addUTCTime (- retentionTime) now
|
|
|
|
n <- updateWhereCount [ TransactionLogTime <. cutoff, TransactionLogRemote !=. Nothing ] [ TransactionLogRemote =. Nothing ]
|
|
$logInfoS "DeleteTransactionLogIPs" [st|Deleted #{n} IP entries from transaction log|]
|