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