49 lines
1,006 B
Haskell
49 lines
1,006 B
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Janitor where
|
|
|
|
import qualified Database.PostgreSQL.Simple as PGS
|
|
|
|
import Control.Monad (void)
|
|
|
|
import Control.Concurrent (threadDelay, forkIO)
|
|
import Control.Concurrent.STM (atomically, modifyTVar)
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Time.Clock (getCurrentTime)
|
|
|
|
-- internal imports
|
|
|
|
import Model.Auth
|
|
import Types.Auth
|
|
|
|
forkCleanProcess
|
|
:: PGS.Connection
|
|
-> TicketStore
|
|
-> IO ()
|
|
forkCleanProcess conn store =
|
|
void $ forkIO $ cleanProcess conn store
|
|
|
|
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
|
|
now <- getCurrentTime
|
|
atomically $
|
|
modifyTVar store (S.filter (\(Ticket _ _ expiry _) -> expiry >= now))
|
|
|
|
cleanTokens
|
|
:: PGS.Connection
|
|
-> IO ()
|
|
cleanTokens conn = do
|
|
now <- getCurrentTime
|
|
void $ deleteOldTokens now conn
|