acid-state-dist 0.1.0.0 → 0.1.0.1

raw patch · 27 files changed

+1193/−7 lines, 27 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• acid-state-dist.cabal +19/−7
• examples/HelloWorldMaster.hs +51/−0
• examples/HelloWorldSlave.hs +51/−0
• examples/HelloWorldSlave_Safe.hs +56/−0
• examples/HelloWorldSlave_Safe2.hs +59/−0
• examples/IntCommon.hs +40/−0
• examples/IntLocalInteractive.hs +41/−0
• examples/IntMasterInteractive.hs +54/−0
• examples/IntSlaveInteractive.hs +45/−0
• examples/RequestTimeout.hs +41/−0
• examples/Threaded.hs +56/−0
• examples/readme.md +20/−0
• examples/slave1/HelloWorldSlave.hs +51/−0
• examples/slave1/HelloWorldSlave_Safe.hs +56/−0
• examples/slave1/HelloWorldSlave_Safe2.hs +59/−0
• examples/slave1/IntCommon.hs +40/−0
• examples/slave1/IntSlaveInteractive.hs +45/−0
• examples/slave2/HelloWorldSlave.hs +51/−0
• examples/slave2/HelloWorldSlave_Safe.hs +56/−0
• examples/slave2/HelloWorldSlave_Safe2.hs +59/−0
• examples/slave2/IntCommon.hs +40/−0
• examples/slave2/IntSlaveInteractive.hs +45/−0
• readme.md +17/−0
• test/ConLossMaster.hs +34/−0
• test/ConLossSlave.hs +34/−0
• test/ConnectionLoss.sh +18/−0
• test/readme.md +55/−0

@@ -10,13 +10,17 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.0+version:             0.1.0.1  -- A short (one-line) description of the package.-synopsis:            Replication backend for acid-state+synopsis:            A replication backend for acid-state  -- A longer description of the package.--- description:+description:         This package provides a backend to AcidState featuring+                     MasterState and SlaveState. Using these allows you to run+                     an acid-state application in a distributed setup, working+                     with the same state everywhere. Optionally redundancy+                     guarantees are available.  -- The license under which the package is released. license:             MIT@@ -40,7 +44,15 @@  -- Extra files to be distributed with the package, such as examples or a -- README.--- extra-source-files:+extra-source-files:  readme.md+                     examples/*.hs+                     examples/readme.md+                     examples/slave1/*.hs+                     examples/slave2/*.hs+                     test/ConLossMaster.hs+                     test/ConLossSlave.hs+                     test/ConnectionLoss.sh+                     test/readme.md  -- Constraint on the version of Cabal needed to build this package. cabal-version:       >=1.10@@ -48,7 +60,7 @@ -- Flag for controlling debug output flag debug   description:       enable debug output-  default:           True+  default:           False  -- Source source-repository head@@ -70,7 +82,7 @@   -- Other library packages from which modules are imported.   build-depends:       base > 4.7 && < 4.9,                        safecopy,-                       acid-state > 0.12 && < 0.13,+                       acid-state > 0.13 && < 0.14,                        concurrent-extra,                        cereal,                        zeromq4-haskell,@@ -90,7 +102,7 @@   default-language:    Haskell2010    default-extensions:       CPP-  ghc-options:      -Wall -threaded+  ghc-options:      -Wall   -- Switch on debugging by "-Unodebug", off by "-Dnodebug"   if flag(debug)     cpp-options:      -Unodebug

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import           Control.Monad.Reader+import           Control.Monad.State+import           Data.Acid+import           Data.Acid.Centered+import           Data.SafeCopy+import           Data.Typeable+import           System.Environment+import           System.Exit (exitSuccess)++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do acid <- openMasterState "127.0.0.1" 3333 (HelloWorldState "Hello world")+          putStrLn "Possible commands: x for exit; q for query; uString for update;"+          forever $ do+              input <- getLine+              case input of+                    ('x':_) -> do+                        putStrLn "Bye!"+                        closeAcidState acid+                        exitSuccess+                    ('q':_) -> do+                        string <- query acid QueryState+                        putStrLn $ "The state is: " ++ string+                    ('u':str) -> do+                        update acid (WriteState str)+                        putStrLn "The state has been modified!"+                    _   -> putStrLn $ "Unknown command " ++ input

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import           Control.Monad.Reader+import           Control.Monad.State+import           Data.Acid+import           Data.Acid.Centered+import           Data.SafeCopy+import           Data.Typeable+import           System.Environment+import           System.Exit (exitSuccess)++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+          putStrLn "Possible commands: x for exit; q for query; uString for update;"+          forever $ do+              input <- getLine+              case input of+                    ('x':_) -> do+                        putStrLn "Bye!"+                        closeAcidState acid+                        exitSuccess+                    ('q':_) -> do+                        string <- query acid QueryState+                        putStrLn $ "The state is: " ++ string+                    ('u':str) -> do+                        update acid (WriteState str)+                        putStrLn "The state has been modified!"+                    _   -> putStrLn $ "Unknown command " ++ input

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = bracket  -- use bracket for safe State deallocation on exceptions.+    (enslaveState "localhost"  3333 (HelloWorldState "Hello world"))+    (\acid -> putStrLn "Finally shutting down Slave." >> closeAcidState acid)+    $ \acid -> do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) ->+                      putStrLn "Bye!"+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ScopedTypeVariables#-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do+    acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+    -- In contrast to the HelloWorldSlave_Safe.hs we do not have async+    -- exceptions masked here:+    handle (\(e :: SomeException) -> putStrLn ("Exceptionally shut down Slave, due to: " ++ show e) >> closeAcidState acid) $ do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) -> do+                      putStrLn "Bye!"+                      closeAcidState acid+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}++module IntCommon where++import Data.Acid+import Data.SafeCopy+import Data.Typeable++import Control.Monad.Reader (ask)+import Control.Monad.State (put, get)+++-- encapsulate some integers++data IntState = IntState Int+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''IntState)++-- transactions++setState :: Int -> Update IntState ()+setState value = put (IntState value)++setStateEven :: Int -> Update IntState Bool+setStateEven value = if even value+    then put (IntState value) >> return True+    else return False++getState :: Query IntState Int+getState = do+    IntState val <- ask+    return val++incrementState :: Update IntState ()+incrementState = do+    IntState val <- get+    put (IntState (val + 1))++$(makeAcidic ''IntState ['setState, 'setStateEven, 'getState, 'incrementState])

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.SafeCopy+import Data.Typeable++import Control.Monad (forever)+import System.Exit (exitSuccess)++-- state structures+import IntCommon++-- actual test+main :: IO ()+main = do+    acid <- openLocalState (IntState 0)+    putStrLn usage+    forever $ do+        input <- getLine+        case input of+            ('x':_) -> do+                putStrLn "Bye!"+                closeAcidState acid+                closeAcidState acid+                --exitSuccess+            ('q':_) -> do+                val <- query acid GetState+                putStrLn $ "Current value: " ++ show val+            ('u':val) -> do+                update acid (SetState (read val :: Int))+                putStrLn "State updated."+            ('i':_) -> update acid IncrementState+            _ -> putStrLn "Unknown command." >> putStrLn usage+++usage :: String+usage = "Possible commands:\+        \\n  x    exit\+        \\n  q    query the state\+        \\n  u v  update to value v\+        \\n  i    increment"

@@ -0,0 +1,54 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered+import Data.Acid.Centered.Master (createArchiveGlobally)+import Data.SafeCopy+import Data.Typeable++import Control.Monad (forever, replicateM_)+import System.Exit (exitSuccess)++-- state structures+import IntCommon++-- actual test+main :: IO ()+main = do+    acid <- openMasterState "127.0.0.1" 3333 (IntState 0)+    putStrLn usage+    forever $ do+        input <- getLine+        case input of+            ('x':_) -> do+                putStrLn "Bye!"+                closeAcidState acid+                exitSuccess+            ('c':_) -> do+                createCheckpoint acid+                putStrLn "Checkpoint generated."+            ('a':_) -> do+                createArchiveGlobally acid+                putStrLn "Archive generated."+            ('q':_) -> do+                val <- query acid GetState+                putStrLn $ "Current value: " ++ show val+            ('u':val) -> do+                update acid (SetState (read val :: Int))+                putStrLn "State updated."+            ('i':_) -> update acid IncrementState >> putStrLn "State incremented."+            ('k':_) -> do+                replicateM_ 1000 $ update acid IncrementState+                putStrLn "State incremented 1k times."+            _ -> putStrLn "Unknown command." >> putStrLn usage+++usage :: String+usage = "Possible commands:\+        \\n  x    exit\+        \\n  c    checkpoint\+        \\n  a    archive globally\+        \\n  q    query the state\+        \\n  u v  update to value v\+        \\n  i    increment\+        \\n  k    increment 1000 times"

@@ -0,0 +1,45 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable++import Control.Monad (forever, replicateM_)+import System.Exit (exitSuccess)++-- state structures+import IntCommon++-- actual test+main :: IO ()+main = do+    acid <- enslaveState "localhost" 3333 (IntState 0)+    putStrLn usage+    forever $ do+        input <- getLine+        case input of+            ('x':_) -> do+                putStrLn "Bye!"+                closeAcidState acid+                exitSuccess+            ('q':_) -> do+                val <- query acid GetState+                putStrLn $ "Current value: " ++ show val+            ('u':val) -> do+                update acid (SetState (read val :: Int))+                putStrLn "State updated."+            ('i':_) -> update acid IncrementState+            ('h':_) -> do+                replicateM_ 100 $ update acid IncrementState+                putStrLn "State incremented 100 times."+            _ -> putStrLn "Unknown command." >> putStrLn usage+++usage :: String+usage = "Possible commands:\+        \\n  x    exit\+        \\n  q    query the state\+        \\n  u v  update to value v\+        \\n  i    increment\+        \\n  h    increment 100 times"

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered++import Control.Monad (when, void)+import Control.Concurrent (threadDelay, forkIO)+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++-- actually interesting stuff+-- This example demonstrates in which way a timeout results in exceptions on a+-- Slave that sends updates.+-- The Slave afterwards also runs into a sync timeout as there is no Master.+slave :: IO ()+slave = do+    acid <- enslaveStateFrom "state/Timeout/s1" "localhost" 3333 (IntState 0)+    putStrLn "Connected. Sending Update."+    void $ forkIO $ do+        res <- update acid (SetStateEven 23)+        putStrLn $ "Update result was " ++ show res+    delaySec 6+    closeAcidState acid++main :: IO ()+main = do+    cleanup "state/Timeout"+    --acid <- openMasterStateFrom "state/Timeout/m" "127.0.0.1" 3333 (IntState 0)+    --closeAcidState acid+    slave

@@ -0,0 +1,56 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered++import Control.Monad (when, void, replicateM_)+import Control.Concurrent (threadDelay, forkIO)+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++-- actually interesting stuff+-- This example demonstrates how exceptions are handled when using the state in+-- a threaded environment: Exceptions in Updates kill the thread that invoked+-- the Update not the Slave.+slave :: IO ()+slave = do+    acid <- enslaveStateFrom "state/Threaded/s1" "localhost" 3333 (IntState 0)+    void $ forkIO $ slaveThread acid+    replicateM_ 7 $ do+        delaySec 1+        putStrLn "s"+    val <- query acid GetState+    putStrLn $ "Slave has value " ++ show val+    closeAcidState acid+    where slaveThread a = do+            delaySec 1+            putStrLn "st"+            delaySec 1+            putStrLn "st"+            update a (SetState (error "not today"))+            replicateM_ 5 $ do+                delaySec 1+                putStrLn "st"++main :: IO ()+main = do+    cleanup "state/Threaded"+    acid <- openMasterStateFrom "state/Threaded/m" "127.0.0.1" 3333 (IntState 0)+    update acid (SetState 23)+    void $ forkIO slave+    replicateM_ 10 $ do+        delaySec 1+        putStrLn "m"+    closeAcidState acid+

@@ -0,0 +1,20 @@+This directory contains some examples demonstrating the use of distributed+acid-state.++The slave1/2 directories contain symlinks for quick testing on one machine.++# HelloWorld++A simple example analogous to the HelloWorld example in acid-state.+Run the Master directly here, Slaves in subdirectories.++The "safe" Slaves demonstrate how to take care of exceptions.++# Int*Interactive++Contains in Int as state, allows for multiple Updates in a row. The IntState is+used in the _tests_ as well.++# Threaded++Demonstrates how Exceptions are handled in threaded usages.

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import           Control.Monad.Reader+import           Control.Monad.State+import           Data.Acid+import           Data.Acid.Centered+import           Data.SafeCopy+import           Data.Typeable+import           System.Environment+import           System.Exit (exitSuccess)++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+          putStrLn "Possible commands: x for exit; q for query; uString for update;"+          forever $ do+              input <- getLine+              case input of+                    ('x':_) -> do+                        putStrLn "Bye!"+                        closeAcidState acid+                        exitSuccess+                    ('q':_) -> do+                        string <- query acid QueryState+                        putStrLn $ "The state is: " ++ string+                    ('u':str) -> do+                        update acid (WriteState str)+                        putStrLn "The state has been modified!"+                    _   -> putStrLn $ "Unknown command " ++ input

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = bracket  -- use bracket for safe State deallocation on exceptions.+    (enslaveState "localhost"  3333 (HelloWorldState "Hello world"))+    (\acid -> putStrLn "Finally shutting down Slave." >> closeAcidState acid)+    $ \acid -> do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) ->+                      putStrLn "Bye!"+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ScopedTypeVariables#-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do+    acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+    -- In contrast to the HelloWorldSlave_Safe.hs we do not have async+    -- exceptions masked here:+    handle (\(e :: SomeException) -> putStrLn ("Exceptionally shut down Slave, due to: " ++ show e) >> closeAcidState acid) $ do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) -> do+                      putStrLn "Bye!"+                      closeAcidState acid+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}++module IntCommon where++import Data.Acid+import Data.SafeCopy+import Data.Typeable++import Control.Monad.Reader (ask)+import Control.Monad.State (put, get)+++-- encapsulate some integers++data IntState = IntState Int+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''IntState)++-- transactions++setState :: Int -> Update IntState ()+setState value = put (IntState value)++setStateEven :: Int -> Update IntState Bool+setStateEven value = if even value+    then put (IntState value) >> return True+    else return False++getState :: Query IntState Int+getState = do+    IntState val <- ask+    return val++incrementState :: Update IntState ()+incrementState = do+    IntState val <- get+    put (IntState (val + 1))++$(makeAcidic ''IntState ['setState, 'setStateEven, 'getState, 'incrementState])

@@ -0,0 +1,45 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable++import Control.Monad (forever, replicateM_)+import System.Exit (exitSuccess)++-- state structures+import IntCommon++-- actual test+main :: IO ()+main = do+    acid <- enslaveState "localhost" 3333 (IntState 0)+    putStrLn usage+    forever $ do+        input <- getLine+        case input of+            ('x':_) -> do+                putStrLn "Bye!"+                closeAcidState acid+                exitSuccess+            ('q':_) -> do+                val <- query acid GetState+                putStrLn $ "Current value: " ++ show val+            ('u':val) -> do+                update acid (SetState (read val :: Int))+                putStrLn "State updated."+            ('i':_) -> update acid IncrementState+            ('h':_) -> do+                replicateM_ 100 $ update acid IncrementState+                putStrLn "State incremented 100 times."+            _ -> putStrLn "Unknown command." >> putStrLn usage+++usage :: String+usage = "Possible commands:\+        \\n  x    exit\+        \\n  q    query the state\+        \\n  u v  update to value v\+        \\n  i    increment\+        \\n  h    increment 100 times"

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import           Control.Monad.Reader+import           Control.Monad.State+import           Data.Acid+import           Data.Acid.Centered+import           Data.SafeCopy+import           Data.Typeable+import           System.Environment+import           System.Exit (exitSuccess)++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+          putStrLn "Possible commands: x for exit; q for query; uString for update;"+          forever $ do+              input <- getLine+              case input of+                    ('x':_) -> do+                        putStrLn "Bye!"+                        closeAcidState acid+                        exitSuccess+                    ('q':_) -> do+                        string <- query acid QueryState+                        putStrLn $ "The state is: " ++ string+                    ('u':str) -> do+                        update acid (WriteState str)+                        putStrLn "The state has been modified!"+                    _   -> putStrLn $ "Unknown command " ++ input

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = bracket  -- use bracket for safe State deallocation on exceptions.+    (enslaveState "localhost"  3333 (HelloWorldState "Hello world"))+    (\acid -> putStrLn "Finally shutting down Slave." >> closeAcidState acid)+    $ \acid -> do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) ->+                      putStrLn "Bye!"+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ScopedTypeVariables#-}++import Control.Monad.Reader+import Control.Monad.State+import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable+import Control.Exception++------------------------------------------------------+-- The Haskell structure that we want to encapsulate++data HelloWorldState = HelloWorldState String+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''HelloWorldState)++------------------------------------------------------+-- The transaction we will execute over the state.++writeState :: String -> Update HelloWorldState ()+writeState newValue+    = put (HelloWorldState newValue)++queryState :: Query HelloWorldState String+queryState = do HelloWorldState string <- ask+                return string++$(makeAcidic ''HelloWorldState ['writeState, 'queryState])++main :: IO ()+main = do+    acid <- enslaveState "localhost"  3333 (HelloWorldState "Hello world")+    -- In contrast to the HelloWorldSlave_Safe.hs we do not have async+    -- exceptions masked here:+    handle (\(e :: SomeException) -> putStrLn ("Exceptionally shut down Slave, due to: " ++ show e) >> closeAcidState acid) $ do+        putStrLn "Possible commands: x for exit; q for query; uString for update;"+        let loop = do+              input <- getLine+              case input of+                  ('x':_) -> do+                      putStrLn "Bye!"+                      closeAcidState acid+                  ('q':_) -> do+                      string <- query acid QueryState+                      putStrLn $ "The state is: " ++ string+                      loop+                  ('u':str) -> do+                      update acid (WriteState str)+                      putStrLn "The state has been modified!"+                      loop+                  _ -> do+                      putStrLn $ "Unknown command " ++ input+                      loop+        loop

@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}++module IntCommon where++import Data.Acid+import Data.SafeCopy+import Data.Typeable++import Control.Monad.Reader (ask)+import Control.Monad.State (put, get)+++-- encapsulate some integers++data IntState = IntState Int+    deriving (Show, Typeable)++$(deriveSafeCopy 0 'base ''IntState)++-- transactions++setState :: Int -> Update IntState ()+setState value = put (IntState value)++setStateEven :: Int -> Update IntState Bool+setStateEven value = if even value+    then put (IntState value) >> return True+    else return False++getState :: Query IntState Int+getState = do+    IntState val <- ask+    return val++incrementState :: Update IntState ()+incrementState = do+    IntState val <- get+    put (IntState (val + 1))++$(makeAcidic ''IntState ['setState, 'setStateEven, 'getState, 'incrementState])

@@ -0,0 +1,45 @@+{-# LANGUAGE TypeFamilies #-}++import Data.Acid+import Data.Acid.Centered+import Data.SafeCopy+import Data.Typeable++import Control.Monad (forever, replicateM_)+import System.Exit (exitSuccess)++-- state structures+import IntCommon++-- actual test+main :: IO ()+main = do+    acid <- enslaveState "localhost" 3333 (IntState 0)+    putStrLn usage+    forever $ do+        input <- getLine+        case input of+            ('x':_) -> do+                putStrLn "Bye!"+                closeAcidState acid+                exitSuccess+            ('q':_) -> do+                val <- query acid GetState+                putStrLn $ "Current value: " ++ show val+            ('u':val) -> do+                update acid (SetState (read val :: Int))+                putStrLn "State updated."+            ('i':_) -> update acid IncrementState+            ('h':_) -> do+                replicateM_ 100 $ update acid IncrementState+                putStrLn "State incremented 100 times."+            _ -> putStrLn "Unknown command." >> putStrLn usage+++usage :: String+usage = "Possible commands:\+        \\n  x    exit\+        \\n  q    query the state\+        \\n  u v  update to value v\+        \\n  i    increment\+        \\n  h    increment 100 times"

@@ -0,0 +1,17 @@+# acid-state-dist++A replication backend for+[acid-state](http://github.com/acid-state/acid-state "acid-state").++Run an acid-state application on multiple nodes and have all instances operate+on the same state.+Two operation modes are provided:++ - **Regular operation**: without redundancy guarantees but fast,+ - **Redundant operation**: guarantees replication on _n_ nodes but slower.++Extented documentation is available via Haddock (/Hackage, as soon as released).++For questions and feedback, feel free to contact me by e-mail+max.voit+hdv@with-eyes.net or via IRC (sdx23 on irc.freenode.net).+

@@ -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+

@@ -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+

@@ -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+

@@ -0,0 +1,55 @@+This directory contains test cases to verify functionality.++# Simple++A test for simple replication. Change initial state by master, check whether+state replicated to Slave.++# SlaveUpdates++Can Slaves request Updates successfully?+Do they also get the transaction result (not only updated state)?+Do Master and other Slaves get the update?++# CRCFail++For diverged state the CRC check must fail (unless Checkpoints were replicated).++# CheckpointSync++A diverged state must be the same after sync-replicating a Checkpoint (i.e.+Slave joins only after generating the checkpoint).++# OrderingRandom++It is essential to keep ordering of events identical on all nodes. This test+applies a non-commutative operation on the state to check this behaviour.++# NReplication++Test for the redundant operation mode. An Update shall only be accepted as soon+as enough Slaves joined.++# UpdateError++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++