diff --git a/acid-state-dist.cabal b/acid-state-dist.cabal --- a/acid-state-dist.cabal +++ b/acid-state-dist.cabal @@ -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 diff --git a/examples/HelloWorldMaster.hs b/examples/HelloWorldMaster.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorldMaster.hs @@ -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 diff --git a/examples/HelloWorldSlave.hs b/examples/HelloWorldSlave.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorldSlave.hs @@ -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 diff --git a/examples/HelloWorldSlave_Safe.hs b/examples/HelloWorldSlave_Safe.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorldSlave_Safe.hs @@ -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 diff --git a/examples/HelloWorldSlave_Safe2.hs b/examples/HelloWorldSlave_Safe2.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorldSlave_Safe2.hs @@ -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 diff --git a/examples/IntCommon.hs b/examples/IntCommon.hs new file mode 100644 --- /dev/null +++ b/examples/IntCommon.hs @@ -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]) diff --git a/examples/IntLocalInteractive.hs b/examples/IntLocalInteractive.hs new file mode 100644 --- /dev/null +++ b/examples/IntLocalInteractive.hs @@ -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" diff --git a/examples/IntMasterInteractive.hs b/examples/IntMasterInteractive.hs new file mode 100644 --- /dev/null +++ b/examples/IntMasterInteractive.hs @@ -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" diff --git a/examples/IntSlaveInteractive.hs b/examples/IntSlaveInteractive.hs new file mode 100644 --- /dev/null +++ b/examples/IntSlaveInteractive.hs @@ -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" diff --git a/examples/RequestTimeout.hs b/examples/RequestTimeout.hs new file mode 100644 --- /dev/null +++ b/examples/RequestTimeout.hs @@ -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 diff --git a/examples/Threaded.hs b/examples/Threaded.hs new file mode 100644 --- /dev/null +++ b/examples/Threaded.hs @@ -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 + diff --git a/examples/readme.md b/examples/readme.md new file mode 100644 --- /dev/null +++ b/examples/readme.md @@ -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. diff --git a/examples/slave1/HelloWorldSlave.hs b/examples/slave1/HelloWorldSlave.hs new file mode 100644 --- /dev/null +++ b/examples/slave1/HelloWorldSlave.hs @@ -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 diff --git a/examples/slave1/HelloWorldSlave_Safe.hs b/examples/slave1/HelloWorldSlave_Safe.hs new file mode 100644 --- /dev/null +++ b/examples/slave1/HelloWorldSlave_Safe.hs @@ -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 diff --git a/examples/slave1/HelloWorldSlave_Safe2.hs b/examples/slave1/HelloWorldSlave_Safe2.hs new file mode 100644 --- /dev/null +++ b/examples/slave1/HelloWorldSlave_Safe2.hs @@ -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 diff --git a/examples/slave1/IntCommon.hs b/examples/slave1/IntCommon.hs new file mode 100644 --- /dev/null +++ b/examples/slave1/IntCommon.hs @@ -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]) diff --git a/examples/slave1/IntSlaveInteractive.hs b/examples/slave1/IntSlaveInteractive.hs new file mode 100644 --- /dev/null +++ b/examples/slave1/IntSlaveInteractive.hs @@ -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" diff --git a/examples/slave2/HelloWorldSlave.hs b/examples/slave2/HelloWorldSlave.hs new file mode 100644 --- /dev/null +++ b/examples/slave2/HelloWorldSlave.hs @@ -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 diff --git a/examples/slave2/HelloWorldSlave_Safe.hs b/examples/slave2/HelloWorldSlave_Safe.hs new file mode 100644 --- /dev/null +++ b/examples/slave2/HelloWorldSlave_Safe.hs @@ -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 diff --git a/examples/slave2/HelloWorldSlave_Safe2.hs b/examples/slave2/HelloWorldSlave_Safe2.hs new file mode 100644 --- /dev/null +++ b/examples/slave2/HelloWorldSlave_Safe2.hs @@ -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 diff --git a/examples/slave2/IntCommon.hs b/examples/slave2/IntCommon.hs new file mode 100644 --- /dev/null +++ b/examples/slave2/IntCommon.hs @@ -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]) diff --git a/examples/slave2/IntSlaveInteractive.hs b/examples/slave2/IntSlaveInteractive.hs new file mode 100644 --- /dev/null +++ b/examples/slave2/IntSlaveInteractive.hs @@ -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" diff --git a/readme.md b/readme.md new file mode 100644 --- /dev/null +++ b/readme.md @@ -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). + diff --git a/test/ConLossMaster.hs b/test/ConLossMaster.hs new file mode 100644 --- /dev/null +++ b/test/ConLossMaster.hs @@ -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 --- /dev/null +++ b/test/ConLossSlave.hs @@ -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 100644 --- /dev/null +++ b/test/ConnectionLoss.sh @@ -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 + diff --git a/test/readme.md b/test/readme.md new file mode 100644 --- /dev/null +++ b/test/readme.md @@ -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 + +