wip

hbs2-tests/test/TestSKey.hs

@@ -2,12 +2,13 @@ module Main where
 
 import HBS2.Net.Proto.Sessions
 import HBS2.Hash
+import HBS2.Clock
 
 
 import Control.Monad
 import Control.Concurrent.STM
 import Data.ByteString (ByteString)
-import Data.ByteString.Lazy.Char8 as B
+import Data.ByteString.Lazy.Char8 qualified as B
 import Data.Cache (Cache)
 import Data.Cache qualified as Cache
 import Data.Map qualified as Map
@@ -16,6 +17,7 @@ import System.Random.MWC
 import System.TimeIt
 import Test.QuickCheck
 import Data.HashMap.Strict qualified as HashMap
+import Control.Concurrent.Async
 
 main :: IO ()
 main = do
@@ -27,6 +29,8 @@ main = do
           bytes <- replicateM 256 $ uniformM g :: IO [Char]
           pure $ hashObject @HbSync (B.pack bytes)
 
+  race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Cache (Hash HbSync) failed") $ do
+
     timeItNamed "Cache (Hash HbSync)" $ do
 
       replicateM_ 1000 $ do
@@ -36,6 +40,7 @@ main = do
         forM_ ss $ \key -> Cache.insert m1 key ()
         forM_ ss $ \key -> Cache.lookup' m1 key
 
+  race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Cache (SKey) failed") $ do
 
     timeItNamed "Cache (SKey)" $ do
 
@@ -48,6 +53,7 @@ main = do
         forM_ keys $ \key -> Cache.insert m1 key ()
         forM_ keys $ \key -> Cache.lookup' m1 key
 
+  race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "HashMap (Hash HbSync) failed") $ do
 
     timeItNamed "HashMap (Hash HbSync)" $ do
 
@@ -66,6 +72,7 @@ main = do
           let !x = HashMap.lookup key m
           pure ()
 
+  race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "HashMap (SKey) failed") $ do
     timeItNamed "HashMap (Skey)" $ do
 
       let keys = fmap newSKey ss
@@ -84,6 +91,7 @@ main = do
           pure ()
 
 
+  race ( pause ( 3 :: Timeout 'Seconds ) >> putStrLn "Map (Hash HbSync) failed") $ do
     timeItNamed "Map (Hash HbSync)" $ do
 
       let keys = ss