content: {-# LANGUAGE OverloadedStrings #-}
  
  module Snap.Internal.Http.Server.TimeoutManager.Tests
    ( tests ) where
  
  ------------------------------------------------------------------------------
  import           Control.Concurrent                       (newEmptyMVar, putMVar, takeMVar)
  import           Control.Concurrent.Thread                (forkIO, result)
  import qualified Control.Exception                        as E
  import           Control.Monad                            (replicateM)
  import           Data.IORef                               (newIORef, readIORef, writeIORef)
  import           Data.Maybe                               (isJust)
  ------------------------------------------------------------------------------
  import qualified Snap.Internal.Http.Server.Clock          as Clock
  import qualified Snap.Internal.Http.Server.TimeoutManager as TM
  import           System.Timeout                           (timeout)
  import           Test.Framework                           (Test)
  import           Test.Framework.Providers.HUnit           (testCase)
  import           Test.HUnit                               (assertBool, assertEqual)
  
  ------------------------------------------------------------------------------
  tests :: [Test]
  tests = [ testOneTimeout
          , testSlowToDie
          , testOneTimeoutAfterInactivity
          , testCancel
          , testTickle ]
  
  
  ------------------------------------------------------------------------------
  register :: IO () -> TM.TimeoutManager -> IO TM.TimeoutThread
  register m t = TM.register t "test" $
                 \restore -> restore (Clock.sleepSecs 9000)
                             `E.finally` m
  
  
  ------------------------------------------------------------------------------
  testOneTimeout :: Test
  testOneTimeout = testCase "timeout/oneTimeout" $ repeatedly $ do
      mgr <- TM.initialize 1 0.1 Clock.getClockTime
      oneTimeout mgr
  
  ------------------------------------------------------------------------------
  testSlowToDie :: Test
  testSlowToDie = testCase "timeout/slowToDie" $ repeatedly $ do
      mgr <- TM.initialize 1 0.1 Clock.getClockTime
      r   <- newIORef False
      s   <- newIORef False
      _   <- register (writeIORef r True >> Clock.sleepSecs 3 >> writeIORef s True) mgr
      Clock.sleepSecs 1.5
      readIORef r >>= assertEqual "started to die" True
      readIORef s >>= assertEqual "not dead yet" False
      Clock.sleepSecs 3
      readIORef s >>= assertEqual "dead" True
  
  
  ------------------------------------------------------------------------------
  testOneTimeoutAfterInactivity :: Test
  testOneTimeoutAfterInactivity =
      testCase "timeout/oneTimeoutAfterInactivity" $ repeatedly $ do
          mgr <- TM.initialize 1 0.1 Clock.getClockTime
          Clock.sleepSecs 3
          oneTimeout mgr
  
  ------------------------------------------------------------------------------
  repeatedly :: IO () -> IO ()
  repeatedly m = dieIfTimeout $ do
      results <- replicateM 40 (forkIO m) >>= sequence . map snd
      mapM_ result results
  
  
  ------------------------------------------------------------------------------
  oneTimeout :: TM.TimeoutManager -> IO ()
  oneTimeout mgr = do
      mv  <- newEmptyMVar
      _   <- register (putMVar mv ()) mgr
      m   <- timeout (3*seconds) $ takeMVar mv
      assertBool "timeout fired" $ isJust m
      Clock.sleepSecs 2
      TM.stop mgr
  
  
  ------------------------------------------------------------------------------
  testTickle :: Test
  testTickle = testCase "timeout/tickle" $ repeatedly $ do
      mgr <- TM.initialize 5 0.1 Clock.getClockTime
      ref <- newIORef (0 :: Int)
      h <- register (writeIORef ref 1) mgr
      E.evaluate (length $ show h)
      Clock.sleepSecs 1
      b0 <- readIORef ref
      assertEqual "b0" 0 b0
      TM.tickle h 3
      Clock.sleepSecs 1
      b1 <- readIORef ref
      assertEqual "b1" 0 b1
      Clock.sleepSecs 5
      b2 <- readIORef ref
      assertEqual "b2" 1 b2
      TM.stop mgr
  
  
  ------------------------------------------------------------------------------
  testCancel :: Test
  testCancel = testCase "timeout/cancel" $ repeatedly $ do
      mgr <- TM.initialize 3 0.1 Clock.getClockTime
      ref <- newIORef (0 :: Int)
      h <- register (writeIORef ref 1) mgr
      Clock.sleepSecs 1
      readIORef ref >>= assertEqual "b0" 0
      TM.cancel h
      TM.tickle h 10              -- make sure tickle ignores cancelled times
      Clock.sleepSecs 2
      readIORef ref >>= assertEqual "b1" 1
      Clock.sleepSecs 2
      h' <- register (writeIORef ref 2) mgr
      _ <- register (return ()) mgr
      TM.set h' 1
      Clock.sleepSecs 2
      readIORef ref >>= assertEqual "b2" 2
      _   <- register (writeIORef ref 3) mgr
      hs <- replicateM 1000 $! register (return ()) mgr
      mapM TM.cancel hs
      TM.stop mgr
      Clock.sleepSecs 1
      readIORef ref >>= assertEqual "b3" 3
  
  
  ------------------------------------------------------------------------------
  seconds :: Int
  seconds = (10::Int) ^ (6::Int)
  
  
  ------------------------------------------------------------------------------
  dieIfTimeout :: IO a -> IO a
  dieIfTimeout m = timeout (30 * seconds) m >>= maybe (error "timeout") return
  