1 module Snap.Internal.Http.Server.TimeoutManager.Tests
    2   ( tests ) where
    3 
    4 import           Control.Concurrent
    5 import           Data.IORef
    6 import           Data.Maybe
    7 import           System.PosixCompat.Time
    8 import           System.Timeout
    9 import           Test.Framework
   10 import           Test.Framework.Providers.HUnit
   11 import           Test.HUnit hiding (Test, path)
   12 
   13 import qualified Snap.Internal.Http.Server.TimeoutManager as TM
   14 
   15 tests :: [Test]
   16 tests = [ testOneTimeout
   17         , testOneTimeoutAfterInactivity
   18         , testCancel
   19         , testTickle ]
   20 
   21 
   22 testOneTimeout :: Test
   23 testOneTimeout = testCase "timeout/oneTimeout" $ do
   24     mgr <- TM.initialize 3 epochTime
   25     oneTimeout mgr
   26 
   27 
   28 testOneTimeoutAfterInactivity :: Test
   29 testOneTimeoutAfterInactivity =
   30     testCase "timeout/oneTimeoutAfterInactivity" $ do
   31         mgr <- TM.initialize 3 epochTime
   32         threadDelay $ 7 * seconds
   33         oneTimeout mgr
   34 
   35 oneTimeout :: TM.TimeoutManager -> IO ()
   36 oneTimeout mgr = do
   37     mv  <- newEmptyMVar
   38     _   <- TM.register (putMVar mv ()) mgr
   39     m   <- timeout (6*seconds) $ takeMVar mv
   40     assertBool "timeout fired" $ isJust m
   41     TM.stop mgr
   42 
   43 
   44 testTickle :: Test
   45 testTickle = testCase "timeout/tickle" $ do
   46     mgr <- TM.initialize 8 epochTime
   47     ref <- newIORef (0 :: Int)
   48     h <- TM.register (writeIORef ref 1) mgr
   49     threadDelay $ 5 * seconds
   50     b0 <- readIORef ref
   51     assertEqual "b0" 0 b0
   52     TM.tickle h 8
   53     threadDelay $ 5 * seconds
   54     b1 <- readIORef ref
   55     assertEqual "b1" 0 b1
   56     threadDelay $ 8 * seconds
   57     b2 <- readIORef ref
   58     assertEqual "b2" 1 b2
   59     TM.stop mgr
   60 
   61 
   62 testCancel :: Test
   63 testCancel = testCase "timeout/cancel" $ do
   64     mgr <- TM.initialize 3 epochTime
   65     ref <- newIORef (0 :: Int)
   66     h <- TM.register (writeIORef ref 1) mgr
   67     threadDelay $ 1 * seconds
   68     TM.cancel h
   69     threadDelay $ 5 * seconds
   70     b0 <- readIORef ref
   71     assertEqual "b0" 0 b0
   72     TM.stop mgr
   73 
   74 
   75 seconds :: Int
   76 seconds = (10::Int) ^ (6::Int)