diff --git a/config/settings.yml b/config/settings.yml index d35732623..bcd9cabcb 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -47,6 +47,8 @@ log-settings: minimum-level: "_env:LOGLEVEL:warn" destination: "_env:LOGDEST:stderr" +ip-retention-time: 1209600 + # Debugging auth-dummy-login: "_env:DUMMY_LOGIN:false" allow-deprecated: "_env:ALLOW_DEPRECATED:false" diff --git a/src/Cron.hs b/src/Cron.hs index 53a7a01b3..5017e71d1 100644 --- a/src/Cron.hs +++ b/src/Cron.hs @@ -23,7 +23,7 @@ import Utils.Lens hiding (from, to) data CronDate = CronDate - { cdYear, cdWeekOfYear, cdDayOfYear + { cdYear, cdWeekYear, cdWeekOfYear, cdDayOfYear , cdMonth, cdWeekOfMonth, cdDayOfMonth , cdDayOfWeek , cdHour, cdMinute, cdSecond :: Natural @@ -48,7 +48,7 @@ toCronDate LocalTime{..} = CronDate{..} = toGregorian localDay (_, fromIntegral -> cdDayOfYear) = toOrdinalDate localDay - (_, fromIntegral -> cdWeekOfYear, fromIntegral -> cdDayOfWeek) + (fromInteger -> cdWeekYear, fromIntegral -> cdWeekOfYear, fromIntegral -> cdDayOfWeek) = toWeekDate localDay cdWeekOfMonth = go 1 localDay where @@ -60,8 +60,8 @@ toCronDate LocalTime{..} = CronDate{..} where (y, w, dow) = toWeekDate day day' - | w /= 0 = fromWeekDate y (pred w) dow - | otherwise = fromWeekDate (pred y) 53 dow + | w > 1 = fromWeekDate y (pred w) dow + | otherwise = fromWeekDate (pred y) 53 dow (_, m, _) = toGregorian day (_, m', _) = toGregorian day' TimeOfDay @@ -73,7 +73,7 @@ toCronDate LocalTime{..} = CronDate{..} consistentCronDate :: CronDate -> Bool consistentCronDate cd@CronDate{ cdWeekOfMonth = _, ..} = fromMaybe False $ do gDay <- fromGregorianValid (fromIntegral cdYear) (fromIntegral cdMonth) (fromIntegral cdDayOfMonth) - wDay <- fromWeekDateValid (fromIntegral cdYear) (fromIntegral cdWeekOfYear) (fromIntegral cdDayOfWeek) + wDay <- fromWeekDateValid (fromIntegral cdWeekYear) (fromIntegral cdWeekOfYear) (fromIntegral cdDayOfWeek) guard $ gDay == wDay oDay <- fromOrdinalDateValid (fromIntegral cdYear) (fromIntegral cdDayOfYear) guard $ wDay == oDay @@ -107,39 +107,40 @@ listToMatch (t:_) = MatchAt t genMatch :: Int -- ^ Period -> Bool -- ^ Modular + -> Bool -- ^ Zero based -> Natural -- ^ Start value -> CronMatch -> [Natural] -genMatch p m st CronMatchAny = take p $ map (bool id (succ . (`mod` fromIntegral p)) m) [st..] -genMatch _ _ _ CronMatchNone = [] -genMatch p m _ (CronMatchSome xs) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) . Set.toAscList $ toNullable xs -genMatch p m st (CronMatchStep step) = do +genMatch p m z st CronMatchAny = take p $ map (bool id (bool succ id z . (`mod` fromIntegral p) . bool pred id z) m) [st..] +genMatch _ _ _ _ CronMatchNone = [] +genMatch p m z _ (CronMatchSome xs) = take p . map (bool id (bool succ id z . (`mod` fromIntegral p) . bool pred id z) m) . Set.toAscList $ toNullable xs +genMatch p m z st (CronMatchStep step) = do start <- [st..st + step] guard $ (start `mod` step) == 0 - take (ceiling $ fromIntegral p % step) $ map (bool id (succ . (`mod` fromIntegral p)) m) [start,start + step..] -genMatch p m st (CronMatchContiguous from to) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) $ [max st from..to] -genMatch _ _ _ (CronMatchIntersect CronMatchNone _) = [] -genMatch _ _ _ (CronMatchIntersect _ CronMatchNone) = [] -genMatch p m st (CronMatchIntersect CronMatchAny other) = genMatch p m st other -genMatch p m st (CronMatchIntersect other CronMatchAny) = genMatch p m st other -genMatch p m st (CronMatchIntersect (CronMatchStep st1) (CronMatchStep st2)) - = genMatch p m st . CronMatchStep $ lcm st1 st2 -genMatch p m st (CronMatchIntersect aGen bGen) + take (ceiling $ fromIntegral p % step) $ map (bool id (bool succ id z . (`mod` fromIntegral p) . bool pred id z) m) [start,start + step..] +genMatch p m z st (CronMatchContiguous from to) = take p . map (bool id (bool succ id z . (`mod` fromIntegral p) . bool pred id z) m) $ [max st from..to] +genMatch _ _ _ _ (CronMatchIntersect CronMatchNone _) = [] +genMatch _ _ _ _ (CronMatchIntersect _ CronMatchNone) = [] +genMatch p m z st (CronMatchIntersect CronMatchAny other) = genMatch p m z st other +genMatch p m z st (CronMatchIntersect other CronMatchAny) = genMatch p m z st other +genMatch p m z st (CronMatchIntersect (CronMatchStep st1) (CronMatchStep st2)) + = genMatch p m z st . CronMatchStep $ lcm st1 st2 +genMatch p m z st (CronMatchIntersect aGen bGen) | [] <- as' = [] - | (a:as) <- as' = mergeAnd (a:as) (genMatch p m a bGen) + | (a:as) <- as' = mergeAnd (a:as) (genMatch p m z a bGen) where - as' = genMatch p m st aGen + as' = genMatch p m z st aGen mergeAnd [] _ = [] mergeAnd _ [] = [] mergeAnd (a:as) (b:bs) | a < b = mergeAnd as (b:bs) | a == b = a : mergeAnd as bs | otherwise = mergeAnd (a:as) bs -genMatch p m st (CronMatchUnion CronMatchNone other) = genMatch p m st other -genMatch p m st (CronMatchUnion other CronMatchNone) = genMatch p m st other -genMatch p m st (CronMatchUnion CronMatchAny _) = genMatch p m st CronMatchAny -genMatch p m st (CronMatchUnion _ CronMatchAny) = genMatch p m st CronMatchAny -genMatch p m st (CronMatchUnion aGen bGen) = merge (genMatch p m st aGen) (genMatch p m st bGen) +genMatch p m z st (CronMatchUnion CronMatchNone other) = genMatch p m z st other +genMatch p m z st (CronMatchUnion other CronMatchNone) = genMatch p m z st other +genMatch p m z st (CronMatchUnion CronMatchAny _) = genMatch p m z st CronMatchAny +genMatch p m z st (CronMatchUnion _ CronMatchAny) = genMatch p m z st CronMatchAny +genMatch p m z st (CronMatchUnion aGen bGen) = merge (genMatch p m z st aGen) (genMatch p m z st bGen) where merge [] bs = bs merge as [] = as @@ -215,28 +216,134 @@ nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of | ref <= ts || not wasExecd -> MatchAt ts | otherwise -> MatchNone CronCalendar{..} -> listToMatch $ do - let CronDate{..} = toCronDate $ utcToLocalTimeTZ tz ref + let + localRef = utcToLocalTimeTZ tz ref + CronDate{..} = toCronDate localRef + + mCronWeekDate <- if + | cronWeekYear == CronMatchAny + , cronWeekOfYear == CronMatchAny + , cronDayOfWeek == CronMatchAny + -> return Nothing + | otherwise + -> fmap Just $ (,,) + <$> genMatch 400 False True cdWeekYear cronWeekYear + <*> genMatch 53 True False cdWeekOfYear cronWeekOfYear + <*> genMatch 7 True False cdDayOfWeek cronDayOfWeek + + mCronGregorianDate <- if + | cronYear == CronMatchAny + , cronMonth == CronMatchAny + , cronDayOfMonth == CronMatchAny + -> return Nothing + | otherwise + -> fmap Just $ (,,) + <$> genMatch 400 False True cdYear cronYear + <*> genMatch 12 True False cdMonth cronMonth + <*> genMatch 31 True False cdDayOfMonth cronDayOfMonth + + mCronWeekOfMonthDate <- if + | cronWeekOfMonth == CronMatchAny + -> return Nothing + | Just (wY, _, wd) <- mCronWeekDate + -> fmap Just $ (,,,) + <$> pure wY + <*> maybe (genMatch 12 True False cdMonth cronMonth) (pure . view _2) mCronGregorianDate + <*> genMatch 5 True False cdWeekOfMonth cronWeekOfMonth + <*> pure wd + | Just (_, m, _) <- mCronGregorianDate + -> fmap Just $ (,,,) + <$> genMatch 400 False True cdWeekYear cronWeekYear + <*> pure m + <*> genMatch 5 True False cdWeekOfMonth cronWeekOfMonth + <*> genMatch 7 True False cdDayOfWeek cronDayOfWeek + | otherwise + -> fmap Just $ (,,,) + <$> genMatch 400 False True cdWeekYear cronWeekYear + <*> genMatch 12 True False cdMonth cronMonth + <*> genMatch 5 True False cdWeekOfMonth cronWeekOfMonth + <*> genMatch 7 True False cdDayOfWeek cronDayOfWeek + + mCronOrdinalDate <- if + | cronYear == CronMatchAny + , cronDayOfYear == CronMatchAny + -> return Nothing + | Just (y, _, _) <- mCronGregorianDate + -> Just . (y,) <$> genMatch 366 True False cdDayOfYear cronDayOfYear + | otherwise + -> fmap Just $ (,) + <$> genMatch 400 False True cdYear cronYear + <*> genMatch 366 True False cdDayOfYear cronDayOfYear + + mCronTime <- if + | cronHour == CronMatchAny + , cronMinute == CronMatchAny + , cronSecond == CronMatchAny + -> return Nothing + | otherwise + -> fmap Just $ (,,) + <$> genMatch 24 True True cdHour cronHour + <*> genMatch 60 True True cdMinute cronMinute + <*> genMatch 60 True True cdSecond cronSecond + + let toGregorian' = over _1 fromIntegral . over _2 fromIntegral . over _3 fromIntegral . toGregorian + (mCronYear, mCronMonth, mCronDayOfMonth) <- if + | Just (year, month, dayOfMonth) <- mCronGregorianDate + -> return (year, month, dayOfMonth) + | Just (weekYear, week, dayOfWeek) <- mCronWeekDate + -> return . toGregorian' $ fromWeekDate (fromIntegral weekYear) (fromIntegral week) (fromIntegral dayOfWeek) + | Just (year, dayOfYear) <- mCronOrdinalDate + -> maybeToList . fmap toGregorian' $ fromOrdinalDateValid (fromIntegral year) (fromIntegral dayOfYear) + | Just (weekYear, month, weekOfMonth, dayOfWeek) <- mCronWeekOfMonthDate + -> do + year <- genMatch 400 False True cdYear cronYear + day <- genMatch 31 True False cdDayOfMonth cronDayOfMonth + jDay <- maybeToList $ fromGregorianValid (fromIntegral year) (fromIntegral month) (fromIntegral day) + guard $ consistentCronDate (toCronDate localRef{ localDay = jDay }) { cdWeekYear = weekYear, cdMonth = month, cdWeekOfMonth = weekOfMonth, cdDayOfWeek = dayOfWeek } + return (year, month, day) + | otherwise + -> fmap toGregorian' [localDay localRef, succ $ localDay localRef] + + julDay <- maybeToList $ fromGregorianValid (fromIntegral mCronYear) (fromIntegral mCronMonth) (fromIntegral mCronDayOfMonth) + + mCronDayOfYear <- if + | Just (year, dayOfYear) <- mCronOrdinalDate + -> dayOfYear <$ guard (year == mCronYear) + | otherwise + -> return . fromIntegral . snd $ toOrdinalDate julDay + + (mCronWeekYear, mCronWeekOfYear, mCronDayOfWeek) <- if + | Just weekDate <- mCronWeekDate + -> return weekDate + | otherwise + -> return . over _1 fromIntegral . over _2 fromIntegral . over _3 fromIntegral $ toWeekDate julDay + + mCronWeekOfMonth <- if + | Just (weekYear, month, weekOfMonth, dayOfWeek) <- mCronWeekOfMonthDate + -> weekOfMonth <$ guard (weekYear == mCronWeekYear && month == mCronMonth && dayOfWeek == mCronDayOfWeek) + | otherwise + -> genMatch 5 True False cdWeekOfMonth cronWeekOfMonth + + (mCronHour, mCronMinute, mCronSecond) <- if + | Just (h, m, s) <- mCronTime + -> return (h, m, s) + | otherwise + -> [(0, 0, 0), (cdHour, cdMinute, cdSecond)] - mCronYear <- genMatch 400 False cdYear cronYear - mCronWeekOfYear <- genMatch 53 True cdWeekOfYear cronWeekOfYear - mCronDayOfYear <- genMatch 366 True cdDayOfYear cronDayOfYear - mCronMonth <- genMatch 12 True cdMonth cronMonth - mCronWeekOfMonth <- genMatch 5 True cdWeekOfMonth cronWeekOfMonth - mCronDayOfMonth <- genMatch 31 True cdDayOfMonth cronDayOfMonth - mCronDayOfWeek <- genMatch 7 True cdDayOfWeek cronDayOfWeek - mCronHour <- genMatch 24 True cdHour cronHour - mCronMinute <- genMatch 60 True cdMinute cronMinute - mCronSecond <- genMatch 60 True cdSecond cronSecond guard $ consistentCronDate CronDate { cdYear = mCronYear, cdMonth = mCronMonth, cdDayOfMonth = mCronDayOfMonth , cdHour = mCronHour, cdMinute = mCronMinute, cdSecond = mCronSecond - , cdWeekOfYear = mCronWeekOfYear, cdWeekOfMonth = mCronWeekOfMonth + , cdWeekYear = mCronWeekYear, cdWeekOfYear = mCronWeekOfYear, cdWeekOfMonth = mCronWeekOfMonth , cdDayOfYear = mCronDayOfYear, cdDayOfWeek = mCronDayOfWeek } localDay <- maybeToList $ fromGregorianValid (fromIntegral mCronYear) (fromIntegral mCronMonth) (fromIntegral mCronDayOfMonth) let localTimeOfDay = TimeOfDay (fromIntegral mCronHour) (fromIntegral mCronMinute) (fromIntegral mCronSecond) - return $ localTimeToUTCTZ tz LocalTime{..} + res = localTimeToUTCTZ tz LocalTime{..} + + guard $ res >= ref + + return res CronNotScheduled -> MatchNone matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry diff --git a/src/Cron/Types.hs b/src/Cron/Types.hs index ab3e92972..576796038 100644 --- a/src/Cron/Types.hs +++ b/src/Cron/Types.hs @@ -1,7 +1,9 @@ module Cron.Types ( Cron(..), Crontab , CronMatch(..) + , cronMatchOne , CronAbsolute(..) + , cronCalendarAny , CronRepeat(..) ) where @@ -14,6 +16,7 @@ import Data.Time import Numeric.Natural import Data.HashMap.Strict (HashMap) +import qualified Data.Set as Set data CronMatch @@ -26,13 +29,16 @@ data CronMatch | CronMatchUnion CronMatch CronMatch deriving (Eq, Show, Read) +cronMatchOne :: Natural -> CronMatch +cronMatchOne = CronMatchSome . impureNonNull . Set.singleton + data CronAbsolute = CronAsap | CronTimestamp { cronTimestamp :: LocalTime } | CronCalendar - { cronYear, cronWeekOfYear, cronDayOfYear + { cronYear, cronWeekYear, cronWeekOfYear, cronDayOfYear , cronMonth, cronWeekOfMonth, cronDayOfMonth , cronDayOfWeek , cronHour, cronMinute, cronSecond :: CronMatch @@ -42,6 +48,21 @@ data CronAbsolute makeLenses_ ''CronAbsolute +cronCalendarAny :: CronAbsolute +cronCalendarAny = CronCalendar + { cronYear = CronMatchAny + , cronWeekYear = CronMatchAny + , cronWeekOfYear = CronMatchAny + , cronDayOfYear = CronMatchAny + , cronMonth = CronMatchAny + , cronWeekOfMonth = CronMatchAny + , cronDayOfMonth = CronMatchAny + , cronDayOfWeek = CronMatchAny + , cronHour = CronMatchAny + , cronMinute = CronMatchAny + , cronSecond = CronMatchAny + } + data CronRepeat = CronRepeatOnChange | CronRepeatScheduled CronAbsolute diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index f0ba27edb..8bb33a222 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -31,36 +31,9 @@ import qualified Data.Set as Set import Data.Time.Clock.System (systemEpochDay) - --------------------- --- NominalDiffTime - --- | One hour in 'NominalDiffTime'. -nominalHour :: NominalDiffTime -nominalHour = 3600 - --- | One minute in 'NominalDiffTime'. -nominalMinute :: NominalDiffTime -nominalMinute= 60 - -formatDiffDays :: NominalDiffTime -> Text -formatDiffDays t - | t > nominalDay = inDays <> "d" - | t > nominalHour = inHours <> "h" - | t > nominalMinute = inMinutes <> "m" - | otherwise = tshow $ roundToDigits 0 t - where - convertBy :: NominalDiffTime -> Double - convertBy len = realToFrac $ roundToDigits 1 $ t / len - inDays = tshow $ convertBy nominalDay - inHours = tshow $ convertBy nominalHour - inMinutes = tshow $ convertBy nominalMinute - - - ------------- --- UTCTime - +------------- +-- UTCTime -- +------------- utcToLocalTime :: UTCTime -> LocalTime utcToLocalTime = TZ.utcToLocalTimeTZ appTZ @@ -198,6 +171,20 @@ dateTimeFormatOptions sel = do optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel +formatDiffDays :: NominalDiffTime -> Text +formatDiffDays t + | t > nominalDay = inDays <> "d" + | t > nominalHour = inHours <> "h" + | t > nominalMinute = inMinutes <> "m" + | otherwise = tshow $ roundToDigits 0 t + where + convertBy :: NominalDiffTime -> Double + convertBy len = realToFrac $ roundToDigits 1 $ t / len + inDays = tshow $ convertBy nominalDay + inHours = tshow $ convertBy nominalHour + inMinutes = tshow $ convertBy nominalMinute + + setYear :: Integer -> Day -> Day setYear year date = fromGregorian year month day where diff --git a/src/Jobs.hs b/src/Jobs.hs index 82914d8d9..ecceaecf5 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -67,6 +67,7 @@ import Jobs.Handler.DistributeCorrections import Jobs.Handler.SendCourseCommunication import Jobs.Handler.Invitation import Jobs.Handler.SendPasswordReset +import Jobs.Handler.TransactionLog import Jobs.HealthReport @@ -239,6 +240,11 @@ execCrontab = do Just (_, MatchNone) -> liftBase retry Just x -> return (crontab, x) + -- do + -- lastTimes <- State.get + -- now <- liftIO getCurrentTime + -- $logDebugS "Crontab" . intercalate "\n" . map tshow . sortOn fst . flip map (HashMap.toList currentCrontab) $ \(job, cron) -> (,job) $ nextCronMatch appTZ (getMax <$> HashMap.lookup job lastTimes) (debouncingAcc settings job) now cron + let doJob = mapRWST (liftHandlerT . runDBJobs . setSerializable) $ do newCrontab <- lift . hoist lift $ determineCrontab' if diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 419fca523..947c0fc09 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -59,6 +59,33 @@ determineCrontab = execWriterT $ do } Nothing -> mempty + let newyear = cronCalendarAny + { cronDayOfYear = cronMatchOne 1 + } + in tell $ HashMap.singleton + (JobCtlQueue JobTruncateTransactionLog) + Cron + { cronInitial = newyear + , cronRepeat = CronRepeatScheduled newyear + , cronRateLimit = minNominalYear + , cronNotAfter = Right CronNotScheduled + } + + oldestLogEntry <- fmap listToMaybe . lift . E.select . E.from $ \transactionLog -> do + E.where_ . E.not_ . E.isNothing $ transactionLog E.^. TransactionLogRemote + E.orderBy [E.asc $ transactionLog E.^. TransactionLogTime] + E.limit 1 + return $ transactionLog E.^. TransactionLogTime + for_ oldestLogEntry $ \(E.Value oldestEntry) -> + tell $ HashMap.singleton + (JobCtlQueue JobDeleteTransactionLogIPs) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appTransactionLogIPRetentionTime oldestEntry + , cronRepeat = CronRepeatOnChange + , cronRateLimit = nominalDay + , cronNotAfter = Right CronNotScheduled + } + let sheetJobs (Entity nSheet Sheet{..}) = do tell $ HashMap.singleton diff --git a/src/Jobs/Handler/TransactionLog.hs b/src/Jobs/Handler/TransactionLog.hs new file mode 100644 index 000000000..63c218b0c --- /dev/null +++ b/src/Jobs/Handler/TransactionLog.hs @@ -0,0 +1,32 @@ +module Jobs.Handler.TransactionLog + ( dispatchJobTruncateTransactionLog + , dispatchJobDeleteTransactionLogIPs + ) where + +import Import hiding (currentYear) +import Utils.Lens hiding ((<.)) +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|] diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index ce89e1d02..ad667cd75 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -48,6 +48,8 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica } | JobSendPasswordReset { jRecipient :: UserId } + | JobTruncateTransactionLog + | JobDeleteTransactionLogIPs deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetActive { nSheet :: SheetId } diff --git a/src/Settings.hs b/src/Settings.hs index 191e1ca1d..ef144f7c6 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -122,6 +122,8 @@ data AppSettings = AppSettings , appInitialLogSettings :: LogSettings + , appTransactionLogIPRetentionTime :: NominalDiffTime + , appReloadTemplates :: Bool -- ^ Use the reload version of templates , appMutableStatic :: Bool @@ -405,6 +407,8 @@ instance FromJSON AppSettings where appInitialLogSettings <- o .: "log-settings" + appTransactionLogIPRetentionTime <- o .: "ip-retention-time" + appUserDefaults <- o .: "user-defaults" appAuthPWHash <- o .: "auth-pw-hash" diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs index 97b73481d..71d120861 100644 --- a/src/Utils/DateTime.hs +++ b/src/Utils/DateTime.hs @@ -6,6 +6,8 @@ module Utils.DateTime , currentYear , DateTimeFormat(..) , SelDateTimeFormat(..) + , nominalHour, nominalMinute + , minNominalYear, avgNominalYear , module Data.Time.Zones , module Data.Time.Zones.TH ) where @@ -13,7 +15,7 @@ module Utils.DateTime import ClassyPrelude.Yesod hiding (lift) import System.Locale.Read -import Data.Time (TimeLocale(..)) +import Data.Time (TimeLocale(..), NominalDiffTime, nominalDay) import Data.Time.Zones (TZ) import Data.Time.Zones.TH (includeSystemTZ) @@ -117,3 +119,20 @@ instance BoundedMeetSemiLattice SelDateTimeFormat where top = SelFormatDateTime instance BoundedLattice SelDateTimeFormat + + +--------------------- +-- NominalDiffTime -- +--------------------- + +-- | One hour in `NominalDiffTime`. +nominalHour :: NominalDiffTime +nominalHour = 3600 + +-- | One minute in `NominalDiffTime`. +nominalMinute :: NominalDiffTime +nominalMinute = 60 + +minNominalYear, avgNominalYear :: NominalDiffTime +minNominalYear = 365 * nominalDay +avgNominalYear = fromRational $ 365.2425 * toRational nominalDay