acid-state-dist-0.1.0.0: test/NReplication.hs

{-# LANGUAGE TypeFamilies #-}

import Data.Acid
import Data.Acid.Centered

import Control.Monad (when, replicateM, void)
import Control.Concurrent (threadDelay, forkIO)
import System.Exit (exitSuccess, exitFailure)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)

-- state structures
import IntCommon

-- helpers
delaySec :: Int -> IO ()
delaySec n = threadDelay $ n*1000*1000

cleanup :: FilePath -> IO ()
cleanup path = do
    sp <- doesDirectoryExist path
    when sp $ removeDirectoryRecursive path

-- actual test
slave :: IO ()
slave = do
    acid <- enslaveRedStateFrom "state/NReplication/s1" "localhost" 3333 (IntState 0)
    delaySec 2
    val <- query acid GetState
    closeAcidState acid
    when (val /= 23) $ putStrLn "Slave hasn't got value." >> exitFailure

main :: IO ()
main = do
    cleanup "state/NReplication"
    acid <- openRedMasterStateFrom "state/NReplication/m" "127.0.0.1" 3333 2 (IntState 0)
    void $ forkIO $ delaySec 2 >> slave
    void $ forkIO $ update acid (SetState 23)      -- this update blocks
    vals <- replicateM 5 $ do
        delaySec 1
        query acid GetState
    closeAcidState acid
    -- queries before the slave joined yield the old state, only after joining
    -- the update is accepted
    if head vals == 0 && last vals == 23
        then exitSuccess
        else exitFailure