mateamt/app/Janitor.hs

49 lines
971 B
Haskell
Raw Permalink Normal View History

2019-10-28 04:47:25 +00:00
module Janitor where
2019-10-31 14:42:15 +00:00
import qualified Database.PostgreSQL.Simple as PGS
import Control.Monad (void)
import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.STM (atomically, modifyTVar)
2019-10-28 04:47:25 +00:00
import qualified Data.Set as S
2019-10-31 14:42:15 +00:00
import Data.Time.Clock (getCurrentTime)
-- internal imports
2019-10-28 04:47:25 +00:00
2019-10-31 14:42:15 +00:00
import Model.Auth
import Types.Auth
2019-10-28 04:47:25 +00:00
2019-10-31 14:42:15 +00:00
forkCleanProcess
:: PGS.Connection
-> TicketStore
-> IO ()
forkCleanProcess conn store =
void $ forkIO $ cleanProcess conn store
2019-10-28 04:47:25 +00:00
2019-10-31 14:42:15 +00:00
cleanProcess
:: PGS.Connection
-> TicketStore
-> IO ()
cleanProcess conn store = do
threadDelay $ 20 * 10 ^ (6 :: Int)
cleanTokens conn
cleanTickets store
cleanProcess conn store
cleanTickets
:: TicketStore
-> IO ()
cleanTickets store = do
2019-10-28 04:47:25 +00:00
now <- getCurrentTime
atomically $
2019-10-31 14:42:15 +00:00
modifyTVar store (S.filter (\(Ticket _ _ expiry _) -> expiry >= now))
cleanTokens
:: PGS.Connection
-> IO ()
cleanTokens conn = do
now <- getCurrentTime
void $ deleteOldTokens now conn