test: connection loss
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 12 Aug 2015 12:25:32 +0000 (14:25 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 12 Aug 2015 12:25:32 +0000 (14:25 +0200)
test/ConLossMaster.hs [new file with mode: 0644]
test/ConLossSlave.hs [new file with mode: 0644]
test/ConnectionLoss.sh [new file with mode: 0755]
test/readme.md

diff --git a/test/ConLossMaster.hs b/test/ConLossMaster.hs
new file mode 100644 (file)
index 0000000..61f570e
--- /dev/null
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, replicateM_)
+import Control.Concurrent (threadDelay)
+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
+main :: IO ()
+main = do
+    cleanup "state/ConLoss"
+    acid <- openMasterStateFrom "state/ConLoss/m" "127.0.0.1" 3333 (IntState 0)
+    replicateM_ 20 $ do
+        delaySec 1
+        update acid IncrementState
+        v <- query acid GetState
+        putStrLn $ "Increment to " ++ show v
+    closeAcidState acid
+
diff --git a/test/ConLossSlave.hs b/test/ConLossSlave.hs
new file mode 100644 (file)
index 0000000..1990793
--- /dev/null
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Acid
+import Data.Acid.Centered
+
+import Control.Monad (when, replicateM_)
+import Control.Concurrent (threadDelay)
+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
+main :: IO ()
+main = do
+    cleanup "state/ConLoss/s1"
+    acid <- enslaveStateFrom "state/ConLoss/s1" "localhost" 3333 (IntState 0)
+    replicateM_ 20 $ do
+        delaySec 1
+        --update acid IncrementState
+        v <- query acid GetState
+        putStrLn $ "Current state at Slave: " ++ show v
+    closeAcidState acid
+
diff --git a/test/ConnectionLoss.sh b/test/ConnectionLoss.sh
new file mode 100755 (executable)
index 0000000..d2faa36
--- /dev/null
@@ -0,0 +1,18 @@
+#!/bin/bash
+
+# start Slave
+xterm -hold -e runhaskell ConLossSlave.hs &
+# start Master
+xterm -hold -e runhaskell ConLossMaster.hs &
+
+# wait & kill connection
+sleep 10
+echo "impeding connection now"
+sudo iptables -A INPUT -p tcp --dport 3333 -j DROP
+sudo iptables -A INPUT -p tcp --sport 3333 -j DROP
+# wait & restore connection
+sleep 5
+echo "stop impeding connection"
+sudo iptables -D INPUT -p tcp --dport 3333 -j DROP
+sudo iptables -D INPUT -p tcp --sport 3333 -j DROP
+
index e260f72..f6de69f 100644 (file)
@@ -37,3 +37,19 @@ Updates containing 'error's are should fail when being scheduled.
 # SyncTimeout
 
 If there is no Master, synchronization is to time out.
+
+
+
+# Extended
+
+Some extended test cases not usually run by 'cabal test' as they require more
+time and/or special precautions.
+
+## ConnectionLoss
+
+Simulates one Slave connected to one Master, losing the network connection.
+This is achieved using iptables, invoked via sudo.
+
+## BigSuite
+
+