mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-27 10:45:14 +00:00
Evgeny
f3408d9bb6
* explicit exports * more empty exports * add exports * reorder * use correct ControlProtocol type for xftp router --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
33 lines
889 B
Haskell
33 lines
889 B
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Simplex.Messaging.Server.Expiration
|
|
( ExpirationConfig (..),
|
|
expireBeforeEpoch,
|
|
showTTL,
|
|
) where
|
|
|
|
import Control.Monad.IO.Class
|
|
import Data.Int (Int64)
|
|
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
|
|
|
|
data ExpirationConfig = ExpirationConfig
|
|
{ -- time after which the entity can be expired, seconds
|
|
ttl :: Int64,
|
|
-- interval to check expiration, seconds
|
|
checkInterval :: Int64
|
|
}
|
|
|
|
expireBeforeEpoch :: ExpirationConfig -> IO Int64
|
|
expireBeforeEpoch ExpirationConfig {ttl} = subtract ttl . systemSeconds <$> liftIO getSystemTime
|
|
|
|
showTTL :: Int64 -> String
|
|
showTTL s
|
|
| s' /= 0 = show s <> " seconds"
|
|
| ms' /= 0 = show ms <> " minutes"
|
|
| hs' /= 0 = show hs <> " hours"
|
|
| otherwise = show ds <> " days"
|
|
where
|
|
(ms, s') = s `divMod` 60
|
|
(hs, ms') = ms `divMod` 60
|
|
(ds, hs') = hs `divMod` 24
|