{-# LANGUAGE ScopedTypeVariables #-}
import Prelude hiding (lookup)
import Control.Concurrent (threadDelay)
import Control.Exception (Exception(..), SomeException(..))
import Control.Monad.Except (runExceptT)
import Control.Monad.Trans.Maybe (runMaybeT)
import Data.Default (Default, def)
import Data.TTLHashTable
import Test.Hspec
import qualified Data.HashTable.ST.Basic as Basic
import qualified Data.HashTable.ST.Cuckoo as Cuckoo
withUnlimitedTTLHashTable :: IO (TTLHashTable Basic.HashTable Int String)
withUnlimitedTTLHashTable = new
withSizedRenewableTTLHashTable :: IO (TTLHashTable Cuckoo.HashTable Int String)
withSizedRenewableTTLHashTable = newWithSettings def { maxSize = 2,
renewUponRead = True,
defaultTTL = 100,
gcMaxEntries = 1 }
main :: IO ()
main = do
hspec $ do
before withUnlimitedTTLHashTable $
describe "TTL Hash Table with default settings" $ do
it "Checks that entries saved can be retrieved" $
\ht -> do
insert ht 1 "foo"
v <- find ht 1
v `shouldBe` Just "foo"
it "Checks that entry expiration is observed" $
\ht -> do
insertWithTTL ht 100 1 "foo" -- TTL is 100 milliseconds
v <- runMaybeT $ lookup ht 1
v `shouldBe` Just "foo"
threadDelay 200000 -- wait 200 mS
v' <- runExceptT $ lookup ht 1
v' `shouldSatisfy` hashTableError ExpiredEntry
it "Checks that size is correctly reported" $
\ht -> do
insertWithTTL ht 100 1 "foo" -- TTL is 100 milliseconds
insert ht 2 "bar"
s <- size ht
s `shouldBe` 2
threadDelay 200000 -- wait 200 mS
s' <- size ht
s' `shouldBe` 2
_ <- find ht 1
s'' <- size ht
s'' `shouldBe` 1
delete ht 2
s''' <- size ht
s''' `shouldBe` 0
it "Checks that lookup doesn't renew entry" $
\ht -> do
insertWithTTL ht 100 1 "foo"
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
v <- find ht 1
v `shouldBe` Nothing
it "Checks garbage collection" $
\ht -> do
insertWithTTL ht 100 2 "foo" -- TTL is 100 milliseconds
threadDelay 200000 -- wait 200 mS
removeExpired ht
s <- size ht
s `shouldBe` 0
before withSizedRenewableTTLHashTable $
describe "Renewable TTL Hash Table with max size" $ do
it "Checks that max size is respected" $
\ht -> do
insert ht 1 "foo"
insert ht 2 "bar"
r <- runExceptT $ insert ht 3 "baz"
r `shouldSatisfy` hashTableError HashTableFull
it "Checks that lookup renews entry" $
\ht -> do
insert ht 1 "foo"
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
_ <- find ht 1
threadDelay 50000 -- wait 50 mS
v <- find ht 1
v `shouldBe` Just "foo"
it "Checks that lookup doesn't renew expired entry" $
\ht -> do
insert ht 1 "foo"
threadDelay 200000 -- 200 mS
v <- runMaybeT $ lookup ht 1
v `shouldBe` Nothing
it "Checks that garbage collection works" $
\ht -> do
insertWithTTL ht 10000000 1 "foo"
insert ht 2 "bar"
threadDelay 200000
left <- removeExpired ht
s <- size ht
s `shouldBe` 1
left `shouldBe` 0
it "Checks that maxGCEntries limit is observed" $
\ht -> do
insert ht 1 "foo"
insert ht 2 "bar"
threadDelay 200000
left <- removeExpired ht
s <- size ht
s `shouldBe` 1
left `shouldBe` 1
left' <- removeExpired ht
s' <- size ht
s' `shouldBe` 0
left' `shouldBe` 0
hashTableError :: TTLHashTableError -> Either SomeException a -> Bool
hashTableError e (Left e') =
case fromException e' of
Just (err::TTLHashTableError) -> err == e
_ -> False