root / test / hs / Test / Ganeti / Locking / Allocation.hs @ 9bf17b50
History | View | Annotate | Download (7.1 kB)
1 | 3469663d | Klaus Aehlig | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | 3469663d | Klaus Aehlig | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | 3469663d | Klaus Aehlig | |
4 | 3469663d | Klaus Aehlig | {-| Tests for lock allocation. |
5 | 3469663d | Klaus Aehlig | |
6 | 3469663d | Klaus Aehlig | -} |
7 | 3469663d | Klaus Aehlig | |
8 | 3469663d | Klaus Aehlig | {- |
9 | 3469663d | Klaus Aehlig | |
10 | 3469663d | Klaus Aehlig | Copyright (C) 2014 Google Inc. |
11 | 3469663d | Klaus Aehlig | |
12 | 3469663d | Klaus Aehlig | This program is free software; you can redistribute it and/or modify |
13 | 3469663d | Klaus Aehlig | it under the terms of the GNU General Public License as published by |
14 | 3469663d | Klaus Aehlig | the Free Software Foundation; either version 2 of the License, or |
15 | 3469663d | Klaus Aehlig | (at your option) any later version. |
16 | 3469663d | Klaus Aehlig | |
17 | 3469663d | Klaus Aehlig | This program is distributed in the hope that it will be useful, but |
18 | 3469663d | Klaus Aehlig | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | 3469663d | Klaus Aehlig | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | 3469663d | Klaus Aehlig | General Public License for more details. |
21 | 3469663d | Klaus Aehlig | |
22 | 3469663d | Klaus Aehlig | You should have received a copy of the GNU General Public License |
23 | 3469663d | Klaus Aehlig | along with this program; if not, write to the Free Software |
24 | 3469663d | Klaus Aehlig | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | 3469663d | Klaus Aehlig | 02110-1301, USA. |
26 | 3469663d | Klaus Aehlig | |
27 | 3469663d | Klaus Aehlig | -} |
28 | 3469663d | Klaus Aehlig | |
29 | 3469663d | Klaus Aehlig | module Test.Ganeti.Locking.Allocation (testLocking_Allocation) where |
30 | 3469663d | Klaus Aehlig | |
31 | 3469663d | Klaus Aehlig | import Control.Applicative |
32 | 9bf17b50 | Klaus Aehlig | import qualified Data.Foldable as F |
33 | 3469663d | Klaus Aehlig | import qualified Data.Map as M |
34 | 3469663d | Klaus Aehlig | import qualified Data.Set as S |
35 | 3469663d | Klaus Aehlig | |
36 | 3469663d | Klaus Aehlig | import Test.QuickCheck |
37 | 3469663d | Klaus Aehlig | |
38 | 987fcfb7 | Klaus Aehlig | import Test.Ganeti.TestCommon |
39 | 3469663d | Klaus Aehlig | import Test.Ganeti.TestHelper |
40 | 3469663d | Klaus Aehlig | |
41 | 1d49428b | Klaus Aehlig | import Ganeti.BasicTypes |
42 | 3469663d | Klaus Aehlig | import Ganeti.Locking.Allocation |
43 | 619b12df | Klaus Aehlig | import Ganeti.Locking.Types |
44 | 3469663d | Klaus Aehlig | |
45 | 3469663d | Klaus Aehlig | {- |
46 | 3469663d | Klaus Aehlig | |
47 | 3469663d | Klaus Aehlig | Ganeti.Locking.Allocation is polymorphic in the types of locks |
48 | 3469663d | Klaus Aehlig | and lock owners. So we can use much simpler types here than Ganeti's |
49 | 3469663d | Klaus Aehlig | real locks and lock owners, knowning at polymorphic functions cannot |
50 | 3469663d | Klaus Aehlig | exploit the simplicity of the types they're deling with. |
51 | 3469663d | Klaus Aehlig | |
52 | 3469663d | Klaus Aehlig | -} |
53 | 3469663d | Klaus Aehlig | |
54 | 3469663d | Klaus Aehlig | data TestOwner = TestOwner Int deriving (Ord, Eq, Show) |
55 | 3469663d | Klaus Aehlig | |
56 | 3469663d | Klaus Aehlig | instance Arbitrary TestOwner where |
57 | 619b12df | Klaus Aehlig | arbitrary = TestOwner <$> choose (0, 2) |
58 | 3469663d | Klaus Aehlig | |
59 | 619b12df | Klaus Aehlig | data TestLock = TestBigLock |
60 | 619b12df | Klaus Aehlig | | TestCollectionLockA |
61 | 619b12df | Klaus Aehlig | | TestLockA Int |
62 | 619b12df | Klaus Aehlig | | TestCollectionLockB |
63 | 619b12df | Klaus Aehlig | | TestLockB Int |
64 | 619b12df | Klaus Aehlig | deriving (Ord, Eq, Show) |
65 | 3469663d | Klaus Aehlig | |
66 | 3469663d | Klaus Aehlig | instance Arbitrary TestLock where |
67 | 619b12df | Klaus Aehlig | arbitrary = frequency [ (1, elements [ TestBigLock |
68 | 619b12df | Klaus Aehlig | , TestCollectionLockA |
69 | 619b12df | Klaus Aehlig | , TestCollectionLockB |
70 | 619b12df | Klaus Aehlig | ]) |
71 | 619b12df | Klaus Aehlig | , (2, TestLockA <$> choose (0, 2)) |
72 | 619b12df | Klaus Aehlig | , (2, TestLockB <$> choose (0, 2)) |
73 | 619b12df | Klaus Aehlig | ] |
74 | 619b12df | Klaus Aehlig | |
75 | 619b12df | Klaus Aehlig | instance Lock TestLock where |
76 | 619b12df | Klaus Aehlig | lockImplications (TestLockA _) = [TestCollectionLockA, TestBigLock] |
77 | 619b12df | Klaus Aehlig | lockImplications (TestLockB _) = [TestCollectionLockB, TestBigLock] |
78 | 619b12df | Klaus Aehlig | lockImplications TestBigLock = [] |
79 | 619b12df | Klaus Aehlig | lockImplications _ = [TestBigLock] |
80 | 3469663d | Klaus Aehlig | |
81 | 3469663d | Klaus Aehlig | {- |
82 | 3469663d | Klaus Aehlig | |
83 | 3469663d | Klaus Aehlig | All states of a LockAllocation can be obtained by starting from the |
84 | 3469663d | Klaus Aehlig | empty allocation, and sequentially requesting (successfully or not) |
85 | 3469663d | Klaus Aehlig | lock updates. So we first define what arbitrary updates sequences are. |
86 | 3469663d | Klaus Aehlig | |
87 | 3469663d | Klaus Aehlig | -} |
88 | 3469663d | Klaus Aehlig | |
89 | 3469663d | Klaus Aehlig | instance Arbitrary OwnerState where |
90 | 3469663d | Klaus Aehlig | arbitrary = elements [OwnShared, OwnExclusive] |
91 | 3469663d | Klaus Aehlig | |
92 | 3469663d | Klaus Aehlig | instance Arbitrary a => Arbitrary (LockRequest a) where |
93 | 3469663d | Klaus Aehlig | arbitrary = LockRequest <$> arbitrary <*> genMaybe arbitrary |
94 | 3469663d | Klaus Aehlig | |
95 | 3469663d | Klaus Aehlig | data UpdateRequest a b = UpdateRequest a [LockRequest b] deriving Show |
96 | 3469663d | Klaus Aehlig | |
97 | 3469663d | Klaus Aehlig | instance (Arbitrary a, Arbitrary b) => Arbitrary (UpdateRequest a b) where |
98 | 3469663d | Klaus Aehlig | arbitrary = UpdateRequest <$> arbitrary <*> arbitrary |
99 | 3469663d | Klaus Aehlig | |
100 | 619b12df | Klaus Aehlig | -- | Fold a sequence of update requests; all allocations can be obtained in |
101 | 3469663d | Klaus Aehlig | -- this way, starting from the empty allocation. |
102 | 619b12df | Klaus Aehlig | foldUpdates :: (Lock a, Ord b, Show b) |
103 | 619b12df | Klaus Aehlig | => LockAllocation a b -> [UpdateRequest b a] -> LockAllocation a b |
104 | 3469663d | Klaus Aehlig | foldUpdates = foldl (\s (UpdateRequest owner updates) -> |
105 | 3469663d | Klaus Aehlig | fst $ updateLocks owner updates s) |
106 | 3469663d | Klaus Aehlig | |
107 | 619b12df | Klaus Aehlig | instance (Arbitrary a, Lock a, Arbitrary b, Ord b, Show b) |
108 | 3469663d | Klaus Aehlig | => Arbitrary (LockAllocation a b) where |
109 | 3469663d | Klaus Aehlig | arbitrary = foldUpdates emptyAllocation <$> arbitrary |
110 | 3469663d | Klaus Aehlig | |
111 | 3469663d | Klaus Aehlig | -- | Basic property of locking: the exclusive locks of one user |
112 | 3469663d | Klaus Aehlig | -- are disjoint from any locks of any other user. |
113 | 3469663d | Klaus Aehlig | prop_LocksDisjoint :: Property |
114 | 3469663d | Klaus Aehlig | prop_LocksDisjoint = |
115 | 3469663d | Klaus Aehlig | forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state -> |
116 | 3469663d | Klaus Aehlig | forAll (arbitrary :: Gen TestOwner) $ \a -> |
117 | 3469663d | Klaus Aehlig | forAll (arbitrary `suchThat` (/= a)) $ \b -> |
118 | 3469663d | Klaus Aehlig | let aExclusive = M.keysSet . M.filter (== OwnExclusive) $ listLocks a state |
119 | 3469663d | Klaus Aehlig | bAll = M.keysSet $ listLocks b state |
120 | 3469663d | Klaus Aehlig | in printTestCase |
121 | 3469663d | Klaus Aehlig | (show a ++ "'s exclusive lock" ++ " is not respected by " ++ show b) |
122 | 3469663d | Klaus Aehlig | (S.null $ S.intersection aExclusive bAll) |
123 | 3469663d | Klaus Aehlig | |
124 | 987fcfb7 | Klaus Aehlig | -- | Verify that locks can only be modified by updates of the owner. |
125 | 987fcfb7 | Klaus Aehlig | prop_LocksStable :: Property |
126 | 987fcfb7 | Klaus Aehlig | prop_LocksStable = |
127 | 987fcfb7 | Klaus Aehlig | forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state -> |
128 | 987fcfb7 | Klaus Aehlig | forAll (arbitrary :: Gen TestOwner) $ \a -> |
129 | 987fcfb7 | Klaus Aehlig | forAll (arbitrary `suchThat` (/= a)) $ \b -> |
130 | 987fcfb7 | Klaus Aehlig | forAll (arbitrary :: Gen [LockRequest TestLock]) $ \request -> |
131 | 987fcfb7 | Klaus Aehlig | let (state', _) = updateLocks b request state |
132 | 987fcfb7 | Klaus Aehlig | in (listLocks a state ==? listLocks a state') |
133 | 987fcfb7 | Klaus Aehlig | |
134 | 1d49428b | Klaus Aehlig | -- | Verify that a given request is statisfied in list of owned locks |
135 | 1d49428b | Klaus Aehlig | requestSucceeded :: Ord a => M.Map a OwnerState -> LockRequest a -> Bool |
136 | 1d49428b | Klaus Aehlig | requestSucceeded owned (LockRequest lock status) = M.lookup lock owned == status |
137 | 1d49428b | Klaus Aehlig | |
138 | 1d49428b | Klaus Aehlig | -- | Verify that lock updates are atomic, i.e., either we get all the required |
139 | 1d49428b | Klaus Aehlig | -- locks, or the state is completely unchanged. |
140 | 1d49428b | Klaus Aehlig | prop_LockupdateAtomic :: Property |
141 | 1d49428b | Klaus Aehlig | prop_LockupdateAtomic = |
142 | 1d49428b | Klaus Aehlig | forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state -> |
143 | 1d49428b | Klaus Aehlig | forAll (arbitrary :: Gen TestOwner) $ \a -> |
144 | 1d49428b | Klaus Aehlig | forAll (arbitrary :: Gen [LockRequest TestLock]) $ \request -> |
145 | 1d49428b | Klaus Aehlig | let (state', result) = updateLocks a request state |
146 | a317d77a | Klaus Aehlig | in if result == Ok S.empty |
147 | 1d49428b | Klaus Aehlig | then printTestCase |
148 | a9c3ba29 | Klaus Aehlig | ("Update succeeded, but in final state " ++ show state' |
149 | 1d49428b | Klaus Aehlig | ++ "not all locks are as requested") |
150 | 1d49428b | Klaus Aehlig | $ let owned = listLocks a state' |
151 | 1d49428b | Klaus Aehlig | in all (requestSucceeded owned) request |
152 | 1d49428b | Klaus Aehlig | else printTestCase |
153 | 1d49428b | Klaus Aehlig | ("Update failed, but state changed to " ++ show state') |
154 | 1d49428b | Klaus Aehlig | (state == state') |
155 | 1d49428b | Klaus Aehlig | |
156 | a9c3ba29 | Klaus Aehlig | -- | Verify that releasing a lock always succeeds. |
157 | a9c3ba29 | Klaus Aehlig | prop_LockReleaseSucceeds :: Property |
158 | a9c3ba29 | Klaus Aehlig | prop_LockReleaseSucceeds = |
159 | a9c3ba29 | Klaus Aehlig | forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state -> |
160 | a9c3ba29 | Klaus Aehlig | forAll (arbitrary :: Gen TestOwner) $ \a -> |
161 | a9c3ba29 | Klaus Aehlig | forAll (arbitrary :: Gen TestLock) $ \lock -> |
162 | a9c3ba29 | Klaus Aehlig | let (_, result) = updateLocks a [requestRelease lock] state |
163 | a9c3ba29 | Klaus Aehlig | in printTestCase |
164 | a9c3ba29 | Klaus Aehlig | ("Releasing a lock has to suceed uncondiationally, but got " |
165 | a9c3ba29 | Klaus Aehlig | ++ show result) |
166 | a9c3ba29 | Klaus Aehlig | (isOk result) |
167 | a9c3ba29 | Klaus Aehlig | |
168 | 9bf17b50 | Klaus Aehlig | -- | Verify the property that only the blocking owners prevent |
169 | 9bf17b50 | Klaus Aehlig | -- lock allocation. We deliberatly go for the expensive variant |
170 | 9bf17b50 | Klaus Aehlig | -- restraining by suchThat, as otherwise the number of cases actually |
171 | 9bf17b50 | Klaus Aehlig | -- covered is too small. |
172 | 9bf17b50 | Klaus Aehlig | prop_BlockSufficient :: Property |
173 | 9bf17b50 | Klaus Aehlig | prop_BlockSufficient = |
174 | 9bf17b50 | Klaus Aehlig | forAll (arbitrary :: Gen TestOwner) $ \a -> |
175 | 9bf17b50 | Klaus Aehlig | forAll (arbitrary :: Gen TestLock) $ \lock -> |
176 | 9bf17b50 | Klaus Aehlig | forAll (elements [ [requestShared lock] |
177 | 9bf17b50 | Klaus Aehlig | , [requestExclusive lock]]) $ \request -> |
178 | 9bf17b50 | Klaus Aehlig | forAll ((arbitrary :: Gen (LockAllocation TestLock TestOwner)) |
179 | 9bf17b50 | Klaus Aehlig | `suchThat` (genericResult (const False) (not . S.null) |
180 | 9bf17b50 | Klaus Aehlig | . snd . updateLocks a request)) $ \state -> |
181 | 9bf17b50 | Klaus Aehlig | let (_, result) = updateLocks a request state |
182 | 9bf17b50 | Klaus Aehlig | blockedOn = genericResult (const S.empty) id result |
183 | 9bf17b50 | Klaus Aehlig | in printTestCase "After all blockers release, a request must succeed" |
184 | 9bf17b50 | Klaus Aehlig | . isOk . snd . updateLocks a request $ F.foldl freeLocks state blockedOn |
185 | 9bf17b50 | Klaus Aehlig | |
186 | 3469663d | Klaus Aehlig | testSuite "Locking/Allocation" |
187 | 3469663d | Klaus Aehlig | [ 'prop_LocksDisjoint |
188 | 987fcfb7 | Klaus Aehlig | , 'prop_LocksStable |
189 | 1d49428b | Klaus Aehlig | , 'prop_LockupdateAtomic |
190 | a9c3ba29 | Klaus Aehlig | , 'prop_LockReleaseSucceeds |
191 | 9bf17b50 | Klaus Aehlig | , 'prop_BlockSufficient |
192 | 3469663d | Klaus Aehlig | ] |