test: Simple refined, SlaveUpdates added
[acid-state-dist.git] / test / SlaveUpdates.hs
1 {-# LANGUAGE TypeFamilies #-}
2
3 import Data.Acid
4 import Data.Acid.Centered
5
6 import Control.Monad (void, when)
7 import Control.Concurrent (threadDelay)
8 import System.Exit (exitSuccess, exitFailure)
9 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
10
11 -- state structures
12 import IntCommon
13
14 -- helpers
15 delaySec :: Int -> IO ()
16 delaySec n = threadDelay $ n*1000*1000
17
18 cleanup :: FilePath -> IO ()
19 cleanup path = do
20     sp <- doesDirectoryExist path
21     when sp $ removeDirectoryRecursive path
22
23 -- actual test
24 slave1 :: IO ()
25 slave1 = do
26     acid <- enslaveStateFrom "state/SlaveUpdates/s1" "localhost" 3333 (IntState 0)
27     update acid (SetState 23)
28     val <- query acid GetState
29     closeAcidState acid
30     when (val /= 23) $ putStrLn "Slave 1 hasn't got value." >> exitFailure
31
32 slave2 :: IO ()
33 slave2 = do
34     acid <- enslaveStateFrom "state/SlaveUpdates/s2" "localhost" 3333 (IntState 0)
35     delaySec 5
36     val <- query acid GetState
37     closeAcidState acid
38     when (val /= 23) $ putStrLn "Slave 2 hasn't got value." >> exitFailure
39
40 main :: IO ()
41 main = do
42     cleanup "state/SlaveUpdates"
43
44     acid <- openMasterStateFrom "state/SlaveUpdates/m" "127.0.0.1" 3333 (IntState 0)
45     slave1
46     slave2
47     val <- query acid GetState
48     closeAcidState acid
49     when (val /= 23) $ putStrLn "Master hasn't got value." >> exitFailure
50
51     exitSuccess
52