Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add Cereal Serialize instances to all states

This should ease the implementations of 'correct' applications, which
should store process state to persistent storage at several points of
the protocol.
  • Loading branch information...
commit 5462f1e35e1ac3f1ffc2ea4de52294e6032ca78c 1 parent 75cf36a
@NicolasT authored
View
3  paxos.cabal
@@ -23,7 +23,8 @@ Library
Network.Paxos.Synod.Proposer,
Network.Paxos.Synod.Acceptor,
Network.Paxos.Synod.Learner
- Other-Modules: Network.Paxos.Synod.Action,
+ Other-Modules: Data.Serialize.QuickCheck,
+ Network.Paxos.Synod.Action,
Network.Paxos.Synod.Types,
Network.Paxos.Synod.Messages
Build-Depends: base >= 4 && < 5,
View
30 src/Data/Serialize/QuickCheck.hs
@@ -0,0 +1,30 @@
+{- Paxos - Implementations of Paxos-related consensus algorithms
+ -
+ - Copyright (C) 2012 Nicolas Trangez
+ -
+ - This library is free software; you can redistribute it and/or
+ - modify it under the terms of the GNU Lesser General Public
+ - License as published by the Free Software Foundation; either
+ - version 2.1 of the License, or (at your option) any later version.
+ -
+ - This library is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ - Lesser General Public License for more details.
+ -
+ - You should have received a copy of the GNU Lesser General Public
+ - License along with this library; if not, write to the Free Software
+ - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
+ - USA.
+ -}
+
+module Data.Serialize.QuickCheck (
+ prop_serialize
+ ) where
+
+import Data.Serialize
+
+import Test.QuickCheck
+
+prop_serialize:: (Eq a, Serialize a, Arbitrary a) => a -> a -> Bool
+prop_serialize _ val = decode (encode val) == Right val
View
19 src/Network/Paxos/Synod/Acceptor.hs
@@ -30,8 +30,14 @@ module Network.Paxos.Synod.Acceptor (
, tests
) where
+import Control.Applicative
+
import Data.Maybe (isNothing)
+import Data.Word (Word32)
+import Data.Serialize
+import Data.Serialize.QuickCheck
+
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -47,6 +53,18 @@ data AcceptorState nodeId value = AcceptorState { highestPromise :: Maybe (Propo
}
deriving (Show, Eq)
+serial :: Word32
+serial = 0x20121214
+
+instance (Serialize nodeId, Serialize value) => Serialize (AcceptorState nodeId value) where
+ get = do
+ serial' <- getWord32le
+ if serial' /= serial
+ then fail "AcceptorState: invalid serial"
+ else AcceptorState <$> get <*> get
+
+ put (AcceptorState a b) = putWord32le serial >> put a >> put b
+
instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (AcceptorState nodeId value) where
arbitrary = do
promised <- arbitrary
@@ -179,4 +197,5 @@ tests = testGroup "Network.Paxos.Synod.Acceptor" [
testProperty "initialize" prop_initialize
, testProperty "handlePrepare" prop_handlePrepare
, testProperty "handleAccept" prop_handleAccept
+ , testProperty "AcceptorState Serialize" $ prop_serialize (undefined :: AcceptorState String Int)
]
View
28 src/Network/Paxos/Synod/Learner.hs
@@ -37,6 +37,10 @@ import Data.Maybe (fromJust, isNothing)
import Data.Map (Map)
import qualified Data.Map as Map
+import Data.Word (Word32)
+import Data.Serialize
+import Data.Serialize.QuickCheck
+
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -53,6 +57,27 @@ data LearnerState nodeId value = Learning { quorum :: Quorum
| Decided value
deriving (Show, Eq)
+serial :: Word32
+serial = 0x20121214
+
+instance (Ord nodeId, Serialize nodeId, Serialize value) => Serialize (LearnerState nodeId value) where
+ get = do
+ serial' <- getWord32le
+ if serial' /= serial
+ then fail "LearnerState: invalid serial"
+ else do
+ tag <- getWord8
+ case tag of
+ 1 -> Learning <$> get <*> get <*> get
+ 2 -> Decided <$> get
+ _ -> fail "LearnerState: invalid tag"
+
+ put state = do
+ putWord32le serial
+ case state of
+ Learning a b c -> putWord8 1 >> put a >> put b >> put c
+ Decided a -> putWord8 2 >> put a
+
instance (Ord nodeId, Arbitrary nodeId, Arbitrary value) => Arbitrary (LearnerState nodeId value) where
arbitrary = oneof [learning, decided]
where
@@ -165,5 +190,6 @@ tests = testGroup "Network.Paxos.Synod.Learner" [
testProperty "initialize" prop_initialize
, testProperty "handleAccepted1" prop_handleAccepted1
, testProperty "handleAccepted2" prop_handleAccepted2
- , testProperty "prop_getValue" prop_getValue
+ , testProperty "getValue" prop_getValue
+ , testProperty "LearnerState Serialize" $ prop_serialize (undefined :: LearnerState String Int)
]
View
16 src/Network/Paxos/Synod/Proposer.hs
@@ -38,6 +38,10 @@ import Control.Applicative
import Data.Maybe (isNothing)
+import Data.Word (Word32)
+import Data.Serialize
+import Data.Serialize.QuickCheck
+
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -56,6 +60,17 @@ data ProposerState nodeId value = ProposerState { proposalId :: ProposalId nodeI
}
deriving (Show, Eq)
+serial :: Word32
+serial = 0x20121213
+
+instance (Serialize nodeId, Serialize value) => Serialize (ProposerState nodeId value) where
+ get = do
+ serial' <- getWord32le
+ if serial' /= serial
+ then fail "ProposerState: invalid serial"
+ else ProposerState <$> get <*> get <*> get <*> get <*> get
+ put (ProposerState a b c d e) = putWord32le serial >> put a >> put b >> put c >> put d >> put e
+
instance (Arbitrary nodeId, Arbitrary value) => Arbitrary (ProposerState nodeId value) where
arbitrary = ProposerState <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -171,4 +186,5 @@ tests = testGroup "Network.Paxos.Synod.Proposer" [
testProperty "startRound1" prop_startRound1
, testProperty "startRound2" prop_startRound2
, testProperty "handlePromise" prop_handlePromise
+ , testProperty "ProposerState Seralize" $ prop_serialize (undefined :: ProposerState String Int)
]
View
7 src/Network/Paxos/Synod/Types.hs
@@ -41,6 +41,7 @@ import Control.Applicative ((<$>), (<*>))
import Data.Word (Word, Word64)
import Data.Serialize
+import Data.Serialize.QuickCheck
import Data.Typeable
import Test.Framework (Test, testGroup)
@@ -115,6 +116,10 @@ prop_bumpProposalId2 p1 p2 = p2' > p1'
newtype Quorum = Quorum { unQuorum :: Word }
deriving (Show, Eq, Ord, Typeable)
+instance Serialize Quorum where
+ get = Quorum <$> get
+ put = put . unQuorum
+
instance Arbitrary Quorum where
arbitrary = Quorum <$> arbitrary
@@ -163,6 +168,7 @@ tests :: Test
tests = testGroup "Network.Paxos.Synod.Types" [
-- ProposalId
testProperty "ProposalId Ord" prop_ProposalId_Ord
+ , testProperty "ProposalId Serialize" $ prop_serialize (undefined :: ProposalId String)
-- succProposalId
, testProperty "succProposalId1" prop_succProposalId1
, testProperty "succProposalId2" prop_succProposalId2
@@ -172,4 +178,5 @@ tests = testGroup "Network.Paxos.Synod.Types" [
-- AcceptedValue
, testProperty "AcceptedValue Eq" prop_AcceptedValue_Eq
, testProperty "AcceptedValue Ord" prop_AcceptedValue_Ord
+ , testProperty "AcceptedValue Serialize" $ prop_serialize (undefined :: AcceptedValue String Int)
]
Please sign in to comment.
Something went wrong with that request. Please try again.