root / htest / Test / Ganeti / HTools / Cluster.hs @ 39f0eea5
History | View | Annotate | Download (18 kB)
1 | e1ee7d5a | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | e1ee7d5a | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | e1ee7d5a | Iustin Pop | |
4 | e1ee7d5a | Iustin Pop | {-| Unittests for ganeti-htools. |
5 | e1ee7d5a | Iustin Pop | |
6 | e1ee7d5a | Iustin Pop | -} |
7 | e1ee7d5a | Iustin Pop | |
8 | e1ee7d5a | Iustin Pop | {- |
9 | e1ee7d5a | Iustin Pop | |
10 | e1ee7d5a | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | e1ee7d5a | Iustin Pop | |
12 | e1ee7d5a | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | e1ee7d5a | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | e1ee7d5a | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | e1ee7d5a | Iustin Pop | (at your option) any later version. |
16 | e1ee7d5a | Iustin Pop | |
17 | e1ee7d5a | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | e1ee7d5a | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | e1ee7d5a | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | e1ee7d5a | Iustin Pop | General Public License for more details. |
21 | e1ee7d5a | Iustin Pop | |
22 | e1ee7d5a | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | e1ee7d5a | Iustin Pop | along with this program; if not, write to the Free Software |
24 | e1ee7d5a | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | e1ee7d5a | Iustin Pop | 02110-1301, USA. |
26 | e1ee7d5a | Iustin Pop | |
27 | e1ee7d5a | Iustin Pop | -} |
28 | e1ee7d5a | Iustin Pop | |
29 | e09c1fa0 | Iustin Pop | module Test.Ganeti.HTools.Cluster (testHTools_Cluster) where |
30 | e1ee7d5a | Iustin Pop | |
31 | 01e52493 | Iustin Pop | import Test.QuickCheck hiding (Result) |
32 | e1ee7d5a | Iustin Pop | |
33 | e1ee7d5a | Iustin Pop | import qualified Data.IntMap as IntMap |
34 | e1ee7d5a | Iustin Pop | import Data.Maybe |
35 | e1ee7d5a | Iustin Pop | |
36 | e1ee7d5a | Iustin Pop | import Test.Ganeti.TestHelper |
37 | e1ee7d5a | Iustin Pop | import Test.Ganeti.TestCommon |
38 | e1ee7d5a | Iustin Pop | import Test.Ganeti.TestHTools |
39 | fb243105 | Iustin Pop | import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode |
40 | fb243105 | Iustin Pop | , genInstanceSmallerThan ) |
41 | e1ee7d5a | Iustin Pop | import Test.Ganeti.HTools.Node (genOnlineNode, genNode) |
42 | e1ee7d5a | Iustin Pop | |
43 | 01e52493 | Iustin Pop | import Ganeti.BasicTypes |
44 | 879d9290 | Iustin Pop | import qualified Ganeti.HTools.Backend.IAlloc as IAlloc |
45 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Cluster as Cluster |
46 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Container as Container |
47 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Group as Group |
48 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Instance as Instance |
49 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Node as Node |
50 | e1ee7d5a | Iustin Pop | import qualified Ganeti.HTools.Types as Types |
51 | e1ee7d5a | Iustin Pop | |
52 | 5b11f8db | Iustin Pop | {-# ANN module "HLint: ignore Use camelCase" #-} |
53 | 5b11f8db | Iustin Pop | |
54 | e1ee7d5a | Iustin Pop | -- * Helpers |
55 | e1ee7d5a | Iustin Pop | |
56 | e1ee7d5a | Iustin Pop | -- | Make a small cluster, both nodes and instances. |
57 | e1ee7d5a | Iustin Pop | makeSmallEmptyCluster :: Node.Node -> Int -> Instance.Instance |
58 | e1ee7d5a | Iustin Pop | -> (Node.List, Instance.List, Instance.Instance) |
59 | e1ee7d5a | Iustin Pop | makeSmallEmptyCluster node count inst = |
60 | e1ee7d5a | Iustin Pop | (makeSmallCluster node count, Container.empty, |
61 | e1ee7d5a | Iustin Pop | setInstanceSmallerThanNode node inst) |
62 | e1ee7d5a | Iustin Pop | |
63 | e1ee7d5a | Iustin Pop | -- | Checks if a node is "big" enough. |
64 | e1ee7d5a | Iustin Pop | isNodeBig :: Int -> Node.Node -> Bool |
65 | e1ee7d5a | Iustin Pop | isNodeBig size node = Node.availDisk node > size * Types.unitDsk |
66 | e1ee7d5a | Iustin Pop | && Node.availMem node > size * Types.unitMem |
67 | e1ee7d5a | Iustin Pop | && Node.availCpu node > size * Types.unitCpu |
68 | e1ee7d5a | Iustin Pop | |
69 | e1ee7d5a | Iustin Pop | canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool |
70 | e1ee7d5a | Iustin Pop | canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0 |
71 | e1ee7d5a | Iustin Pop | |
72 | e1ee7d5a | Iustin Pop | -- | Assigns a new fresh instance to a cluster; this is not |
73 | e1ee7d5a | Iustin Pop | -- allocation, so no resource checks are done. |
74 | e1ee7d5a | Iustin Pop | assignInstance :: Node.List -> Instance.List -> Instance.Instance -> |
75 | e1ee7d5a | Iustin Pop | Types.Idx -> Types.Idx -> |
76 | e1ee7d5a | Iustin Pop | (Node.List, Instance.List) |
77 | e1ee7d5a | Iustin Pop | assignInstance nl il inst pdx sdx = |
78 | e1ee7d5a | Iustin Pop | let pnode = Container.find pdx nl |
79 | e1ee7d5a | Iustin Pop | snode = Container.find sdx nl |
80 | e1ee7d5a | Iustin Pop | maxiidx = if Container.null il |
81 | e1ee7d5a | Iustin Pop | then 0 |
82 | e1ee7d5a | Iustin Pop | else fst (Container.findMax il) + 1 |
83 | e1ee7d5a | Iustin Pop | inst' = inst { Instance.idx = maxiidx, |
84 | e1ee7d5a | Iustin Pop | Instance.pNode = pdx, Instance.sNode = sdx } |
85 | e1ee7d5a | Iustin Pop | pnode' = Node.setPri pnode inst' |
86 | e1ee7d5a | Iustin Pop | snode' = Node.setSec snode inst' |
87 | e1ee7d5a | Iustin Pop | nl' = Container.addTwo pdx pnode' sdx snode' nl |
88 | e1ee7d5a | Iustin Pop | il' = Container.add maxiidx inst' il |
89 | e1ee7d5a | Iustin Pop | in (nl', il') |
90 | e1ee7d5a | Iustin Pop | |
91 | e1ee7d5a | Iustin Pop | -- | Checks if an instance is mirrored. |
92 | e1ee7d5a | Iustin Pop | isMirrored :: Instance.Instance -> Bool |
93 | e1ee7d5a | Iustin Pop | isMirrored = (/= Types.MirrorNone) . Instance.mirrorType |
94 | e1ee7d5a | Iustin Pop | |
95 | e1ee7d5a | Iustin Pop | -- | Returns the possible change node types for a disk template. |
96 | e1ee7d5a | Iustin Pop | evacModeOptions :: Types.MirrorType -> [Types.EvacMode] |
97 | e1ee7d5a | Iustin Pop | evacModeOptions Types.MirrorNone = [] |
98 | e1ee7d5a | Iustin Pop | evacModeOptions Types.MirrorInternal = [minBound..maxBound] -- DRBD can do all |
99 | e1ee7d5a | Iustin Pop | evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll] |
100 | e1ee7d5a | Iustin Pop | |
101 | e1ee7d5a | Iustin Pop | -- * Test cases |
102 | e1ee7d5a | Iustin Pop | |
103 | e1ee7d5a | Iustin Pop | -- | Check that the cluster score is close to zero for a homogeneous |
104 | e1ee7d5a | Iustin Pop | -- cluster. |
105 | 20bc5360 | Iustin Pop | prop_Score_Zero :: Node.Node -> Property |
106 | 20bc5360 | Iustin Pop | prop_Score_Zero node = |
107 | e1ee7d5a | Iustin Pop | forAll (choose (1, 1024)) $ \count -> |
108 | e1ee7d5a | Iustin Pop | (not (Node.offline node) && not (Node.failN1 node) && (count > 0) && |
109 | e1ee7d5a | Iustin Pop | (Node.tDsk node > 0) && (Node.tMem node > 0)) ==> |
110 | e1ee7d5a | Iustin Pop | let fn = Node.buildPeers node Container.empty |
111 | e1ee7d5a | Iustin Pop | nlst = replicate count fn |
112 | e1ee7d5a | Iustin Pop | score = Cluster.compCVNodes nlst |
113 | e1ee7d5a | Iustin Pop | -- we can't say == 0 here as the floating point errors accumulate; |
114 | e1ee7d5a | Iustin Pop | -- this should be much lower than the default score in CLI.hs |
115 | e1ee7d5a | Iustin Pop | in score <= 1e-12 |
116 | e1ee7d5a | Iustin Pop | |
117 | e1ee7d5a | Iustin Pop | -- | Check that cluster stats are sane. |
118 | 20bc5360 | Iustin Pop | prop_CStats_sane :: Property |
119 | 20bc5360 | Iustin Pop | prop_CStats_sane = |
120 | e1ee7d5a | Iustin Pop | forAll (choose (1, 1024)) $ \count -> |
121 | e1ee7d5a | Iustin Pop | forAll genOnlineNode $ \node -> |
122 | e1ee7d5a | Iustin Pop | let fn = Node.buildPeers node Container.empty |
123 | e1ee7d5a | Iustin Pop | nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] |
124 | e1ee7d5a | Iustin Pop | nl = Container.fromList nlst |
125 | e1ee7d5a | Iustin Pop | cstats = Cluster.totalResources nl |
126 | e1ee7d5a | Iustin Pop | in Cluster.csAdsk cstats >= 0 && |
127 | e1ee7d5a | Iustin Pop | Cluster.csAdsk cstats <= Cluster.csFdsk cstats |
128 | e1ee7d5a | Iustin Pop | |
129 | e1ee7d5a | Iustin Pop | -- | Check that one instance is allocated correctly, without |
130 | e1ee7d5a | Iustin Pop | -- rebalances needed. |
131 | 20bc5360 | Iustin Pop | prop_Alloc_sane :: Instance.Instance -> Property |
132 | 20bc5360 | Iustin Pop | prop_Alloc_sane inst = |
133 | e1ee7d5a | Iustin Pop | forAll (choose (5, 20)) $ \count -> |
134 | e1ee7d5a | Iustin Pop | forAll genOnlineNode $ \node -> |
135 | e1ee7d5a | Iustin Pop | let (nl, il, inst') = makeSmallEmptyCluster node count inst |
136 | e1ee7d5a | Iustin Pop | reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
137 | e1ee7d5a | Iustin Pop | in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
138 | e1ee7d5a | Iustin Pop | Cluster.tryAlloc nl il inst' of |
139 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
140 | 01e52493 | Iustin Pop | Ok as -> |
141 | e1ee7d5a | Iustin Pop | case Cluster.asSolution as of |
142 | 650e5aa4 | Iustin Pop | Nothing -> failTest "Failed to allocate, empty solution" |
143 | e1ee7d5a | Iustin Pop | Just (xnl, xi, _, cv) -> |
144 | e1ee7d5a | Iustin Pop | let il' = Container.add (Instance.idx xi) xi il |
145 | e1ee7d5a | Iustin Pop | tbl = Cluster.Table xnl il' cv [] |
146 | 650e5aa4 | Iustin Pop | in printTestCase "Cluster can be balanced after allocation" |
147 | 650e5aa4 | Iustin Pop | (not (canBalance tbl True True False)) .&&. |
148 | 650e5aa4 | Iustin Pop | printTestCase "Solution score differs from actual node list:" |
149 | 650e5aa4 | Iustin Pop | (Cluster.compCV xnl ==? cv) |
150 | e1ee7d5a | Iustin Pop | |
151 | d83903ee | Iustin Pop | -- | Check that multiple instances can allocated correctly, without |
152 | d83903ee | Iustin Pop | -- rebalances needed. |
153 | d83903ee | Iustin Pop | prop_IterateAlloc_sane :: Instance.Instance -> Property |
154 | d83903ee | Iustin Pop | prop_IterateAlloc_sane inst = |
155 | d83903ee | Iustin Pop | forAll (choose (5, 10)) $ \count -> |
156 | d83903ee | Iustin Pop | forAll genOnlineNode $ \node -> |
157 | d83903ee | Iustin Pop | forAll (choose (2, 5)) $ \limit -> |
158 | d83903ee | Iustin Pop | let (nl, il, inst') = makeSmallEmptyCluster node count inst |
159 | d83903ee | Iustin Pop | reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
160 | d83903ee | Iustin Pop | allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True |
161 | d83903ee | Iustin Pop | in case allocnodes >>= \allocnodes' -> |
162 | d83903ee | Iustin Pop | Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of |
163 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
164 | 01e52493 | Iustin Pop | Ok (_, xnl, xil, _, _) -> |
165 | d83903ee | Iustin Pop | let old_score = Cluster.compCV xnl |
166 | d83903ee | Iustin Pop | tbl = Cluster.Table xnl xil old_score [] |
167 | d83903ee | Iustin Pop | in case Cluster.tryBalance tbl True True False 0 1e-4 of |
168 | d83903ee | Iustin Pop | Nothing -> passTest |
169 | d83903ee | Iustin Pop | Just (Cluster.Table ynl _ new_score plcs) -> |
170 | d83903ee | Iustin Pop | -- note that with a "min_gain" of zero, sometime |
171 | d83903ee | Iustin Pop | -- rounding errors can trigger a rebalance that |
172 | d83903ee | Iustin Pop | -- improves the score by e.g. 2e-14; in order to |
173 | d83903ee | Iustin Pop | -- prevent such no-real-change moves from happening, |
174 | d83903ee | Iustin Pop | -- we check for a min-gain of 1e-9 |
175 | d83903ee | Iustin Pop | -- FIXME: correct rebalancing to not do no-ops |
176 | d83903ee | Iustin Pop | printTestCase |
177 | d83903ee | Iustin Pop | ("Cluster can be balanced after allocation\n" ++ |
178 | d83903ee | Iustin Pop | " old cluster (score " ++ show old_score ++ |
179 | d83903ee | Iustin Pop | "):\n" ++ Cluster.printNodes xnl [] ++ |
180 | d83903ee | Iustin Pop | " new cluster (score " ++ show new_score ++ |
181 | d83903ee | Iustin Pop | "):\n" ++ Cluster.printNodes ynl [] ++ |
182 | d83903ee | Iustin Pop | "placements:\n" ++ show plcs ++ "\nscore delta: " ++ |
183 | d83903ee | Iustin Pop | show (old_score - new_score)) |
184 | d83903ee | Iustin Pop | (old_score - new_score < 1e-9) |
185 | d83903ee | Iustin Pop | |
186 | e1ee7d5a | Iustin Pop | -- | Checks that on a 2-5 node cluster, we can allocate a random |
187 | e1ee7d5a | Iustin Pop | -- instance spec via tiered allocation (whatever the original instance |
188 | e1ee7d5a | Iustin Pop | -- spec), on either one or two nodes. Furthermore, we test that |
189 | e1ee7d5a | Iustin Pop | -- computed allocation statistics are correct. |
190 | fb243105 | Iustin Pop | prop_CanTieredAlloc :: Property |
191 | fb243105 | Iustin Pop | prop_CanTieredAlloc = |
192 | e1ee7d5a | Iustin Pop | forAll (choose (2, 5)) $ \count -> |
193 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
194 | fb243105 | Iustin Pop | forAll (genInstanceSmallerThan |
195 | fb243105 | Iustin Pop | (Node.availMem node + Types.unitMem * 2) |
196 | fb243105 | Iustin Pop | (Node.availDisk node + Types.unitDsk * 3) |
197 | fb243105 | Iustin Pop | (Node.availCpu node + Types.unitCpu * 4)) $ \inst -> |
198 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
199 | e1ee7d5a | Iustin Pop | il = Container.empty |
200 | e1ee7d5a | Iustin Pop | rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
201 | e1ee7d5a | Iustin Pop | allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True |
202 | e1ee7d5a | Iustin Pop | in case allocnodes >>= \allocnodes' -> |
203 | fb243105 | Iustin Pop | Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of |
204 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg |
205 | 01e52493 | Iustin Pop | Ok (_, nl', il', ixes, cstats) -> |
206 | e1ee7d5a | Iustin Pop | let (ai_alloc, ai_pool, ai_unav) = |
207 | e1ee7d5a | Iustin Pop | Cluster.computeAllocationDelta |
208 | e1ee7d5a | Iustin Pop | (Cluster.totalResources nl) |
209 | e1ee7d5a | Iustin Pop | (Cluster.totalResources nl') |
210 | fb243105 | Iustin Pop | all_nodes fn = sum $ map fn (Container.elems nl) |
211 | fb243105 | Iustin Pop | all_res fn = sum $ map fn [ai_alloc, ai_pool, ai_unav] |
212 | fb243105 | Iustin Pop | in conjoin |
213 | fb243105 | Iustin Pop | [ printTestCase "No instances allocated" $ not (null ixes) |
214 | fb243105 | Iustin Pop | , IntMap.size il' ==? length ixes |
215 | fb243105 | Iustin Pop | , length ixes ==? length cstats |
216 | fb243105 | Iustin Pop | , all_res Types.allocInfoVCpus ==? all_nodes Node.hiCpu |
217 | fb243105 | Iustin Pop | , all_res Types.allocInfoNCpus ==? all_nodes Node.tCpu |
218 | fb243105 | Iustin Pop | , all_res Types.allocInfoMem ==? truncate (all_nodes Node.tMem) |
219 | fb243105 | Iustin Pop | , all_res Types.allocInfoDisk ==? truncate (all_nodes Node.tDsk) |
220 | fb243105 | Iustin Pop | ] |
221 | e1ee7d5a | Iustin Pop | |
222 | e1ee7d5a | Iustin Pop | -- | Helper function to create a cluster with the given range of nodes |
223 | e1ee7d5a | Iustin Pop | -- and allocate an instance on it. |
224 | e1ee7d5a | Iustin Pop | genClusterAlloc :: Int -> Node.Node -> Instance.Instance |
225 | 01e52493 | Iustin Pop | -> Result (Node.List, Instance.List, Instance.Instance) |
226 | e1ee7d5a | Iustin Pop | genClusterAlloc count node inst = |
227 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
228 | e1ee7d5a | Iustin Pop | reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
229 | e1ee7d5a | Iustin Pop | in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
230 | e1ee7d5a | Iustin Pop | Cluster.tryAlloc nl Container.empty inst of |
231 | 01e52493 | Iustin Pop | Bad msg -> Bad $ "Can't allocate: " ++ msg |
232 | 01e52493 | Iustin Pop | Ok as -> |
233 | e1ee7d5a | Iustin Pop | case Cluster.asSolution as of |
234 | 01e52493 | Iustin Pop | Nothing -> Bad "Empty solution?" |
235 | e1ee7d5a | Iustin Pop | Just (xnl, xi, _, _) -> |
236 | e1ee7d5a | Iustin Pop | let xil = Container.add (Instance.idx xi) xi Container.empty |
237 | 01e52493 | Iustin Pop | in Ok (xnl, xil, xi) |
238 | e1ee7d5a | Iustin Pop | |
239 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster, once we allocate an instance, |
240 | e1ee7d5a | Iustin Pop | -- we can also relocate it. |
241 | 20bc5360 | Iustin Pop | prop_AllocRelocate :: Property |
242 | 20bc5360 | Iustin Pop | prop_AllocRelocate = |
243 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
244 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
245 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
246 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
247 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
248 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
249 | e1ee7d5a | Iustin Pop | case IAlloc.processRelocate defGroupList nl il |
250 | e1ee7d5a | Iustin Pop | (Instance.idx inst) 1 |
251 | e1ee7d5a | Iustin Pop | [(if Instance.diskTemplate inst' == Types.DTDrbd8 |
252 | e1ee7d5a | Iustin Pop | then Instance.sNode |
253 | e1ee7d5a | Iustin Pop | else Instance.pNode) inst'] of |
254 | 01e52493 | Iustin Pop | Ok _ -> passTest |
255 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to relocate: " ++ msg |
256 | e1ee7d5a | Iustin Pop | |
257 | e1ee7d5a | Iustin Pop | -- | Helper property checker for the result of a nodeEvac or |
258 | e1ee7d5a | Iustin Pop | -- changeGroup operation. |
259 | e1ee7d5a | Iustin Pop | check_EvacMode :: Group.Group -> Instance.Instance |
260 | 01e52493 | Iustin Pop | -> Result (Node.List, Instance.List, Cluster.EvacSolution) |
261 | e1ee7d5a | Iustin Pop | -> Property |
262 | e1ee7d5a | Iustin Pop | check_EvacMode grp inst result = |
263 | e1ee7d5a | Iustin Pop | case result of |
264 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg |
265 | 01e52493 | Iustin Pop | Ok (_, _, es) -> |
266 | e1ee7d5a | Iustin Pop | let moved = Cluster.esMoved es |
267 | e1ee7d5a | Iustin Pop | failed = Cluster.esFailed es |
268 | e1ee7d5a | Iustin Pop | opcodes = not . null $ Cluster.esOpCodes es |
269 | 942a9a6a | Iustin Pop | in conjoin |
270 | 942a9a6a | Iustin Pop | [ failmsg ("'failed' not empty: " ++ show failed) (null failed) |
271 | 942a9a6a | Iustin Pop | , failmsg "'opcodes' is null" opcodes |
272 | 942a9a6a | Iustin Pop | , case moved of |
273 | 942a9a6a | Iustin Pop | [(idx', gdx, _)] -> |
274 | 942a9a6a | Iustin Pop | failmsg "invalid instance moved" (idx == idx') .&&. |
275 | 942a9a6a | Iustin Pop | failmsg "wrong target group" (gdx == Group.idx grp) |
276 | 942a9a6a | Iustin Pop | v -> failmsg ("invalid solution: " ++ show v) False |
277 | 942a9a6a | Iustin Pop | ] |
278 | e1ee7d5a | Iustin Pop | where failmsg :: String -> Bool -> Property |
279 | 5b11f8db | Iustin Pop | failmsg msg = printTestCase ("Failed to evacuate: " ++ msg) |
280 | e1ee7d5a | Iustin Pop | idx = Instance.idx inst |
281 | e1ee7d5a | Iustin Pop | |
282 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster, once we allocate an instance, |
283 | e1ee7d5a | Iustin Pop | -- we can also node-evacuate it. |
284 | 20bc5360 | Iustin Pop | prop_AllocEvacuate :: Property |
285 | 20bc5360 | Iustin Pop | prop_AllocEvacuate = |
286 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
287 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
288 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
289 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
290 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
291 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
292 | e1ee7d5a | Iustin Pop | conjoin . map (\mode -> check_EvacMode defGroup inst' $ |
293 | e1ee7d5a | Iustin Pop | Cluster.tryNodeEvac defGroupList nl il mode |
294 | e1ee7d5a | Iustin Pop | [Instance.idx inst']) . |
295 | e1ee7d5a | Iustin Pop | evacModeOptions . |
296 | e1ee7d5a | Iustin Pop | Instance.mirrorType $ inst' |
297 | e1ee7d5a | Iustin Pop | |
298 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster with two node groups, once we |
299 | e1ee7d5a | Iustin Pop | -- allocate an instance on the first node group, we can also change |
300 | e1ee7d5a | Iustin Pop | -- its group. |
301 | 20bc5360 | Iustin Pop | prop_AllocChangeGroup :: Property |
302 | 20bc5360 | Iustin Pop | prop_AllocChangeGroup = |
303 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
304 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
305 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
306 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
307 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
308 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
309 | e1ee7d5a | Iustin Pop | -- we need to add a second node group and nodes to the cluster |
310 | e1ee7d5a | Iustin Pop | let nl2 = Container.elems $ makeSmallCluster node count |
311 | e1ee7d5a | Iustin Pop | grp2 = Group.setIdx defGroup (Group.idx defGroup + 1) |
312 | e1ee7d5a | Iustin Pop | maxndx = maximum . map Node.idx $ nl2 |
313 | e1ee7d5a | Iustin Pop | nl3 = map (\n -> n { Node.group = Group.idx grp2 |
314 | e1ee7d5a | Iustin Pop | , Node.idx = Node.idx n + maxndx }) nl2 |
315 | e1ee7d5a | Iustin Pop | nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3 |
316 | e1ee7d5a | Iustin Pop | gl' = Container.add (Group.idx grp2) grp2 defGroupList |
317 | e1ee7d5a | Iustin Pop | nl' = IntMap.union nl nl4 |
318 | e1ee7d5a | Iustin Pop | in check_EvacMode grp2 inst' $ |
319 | e1ee7d5a | Iustin Pop | Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst'] |
320 | e1ee7d5a | Iustin Pop | |
321 | e1ee7d5a | Iustin Pop | -- | Check that allocating multiple instances on a cluster, then |
322 | e1ee7d5a | Iustin Pop | -- adding an empty node, results in a valid rebalance. |
323 | 20bc5360 | Iustin Pop | prop_AllocBalance :: Property |
324 | 20bc5360 | Iustin Pop | prop_AllocBalance = |
325 | e1ee7d5a | Iustin Pop | forAll (genNode (Just 5) (Just 128)) $ \node -> |
326 | e1ee7d5a | Iustin Pop | forAll (choose (3, 5)) $ \count -> |
327 | e1ee7d5a | Iustin Pop | not (Node.offline node) && not (Node.failN1 node) ==> |
328 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
329 | b9612abb | Iustin Pop | hnode = snd $ IntMap.findMax nl |
330 | b9612abb | Iustin Pop | nl' = IntMap.deleteMax nl |
331 | e1ee7d5a | Iustin Pop | il = Container.empty |
332 | e1ee7d5a | Iustin Pop | allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True |
333 | e1ee7d5a | Iustin Pop | i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu |
334 | e1ee7d5a | Iustin Pop | in case allocnodes >>= \allocnodes' -> |
335 | e1ee7d5a | Iustin Pop | Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of |
336 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to allocate: " ++ msg |
337 | 01e52493 | Iustin Pop | Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances" |
338 | 01e52493 | Iustin Pop | Ok (_, xnl, il', _, _) -> |
339 | e1ee7d5a | Iustin Pop | let ynl = Container.add (Node.idx hnode) hnode xnl |
340 | e1ee7d5a | Iustin Pop | cv = Cluster.compCV ynl |
341 | e1ee7d5a | Iustin Pop | tbl = Cluster.Table ynl il' cv [] |
342 | e1ee7d5a | Iustin Pop | in printTestCase "Failed to rebalance" $ |
343 | e1ee7d5a | Iustin Pop | canBalance tbl True True False |
344 | e1ee7d5a | Iustin Pop | |
345 | e1ee7d5a | Iustin Pop | -- | Checks consistency. |
346 | 20bc5360 | Iustin Pop | prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool |
347 | 20bc5360 | Iustin Pop | prop_CheckConsistency node inst = |
348 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node 3 |
349 | 39f0eea5 | Iustin Pop | (node1, node2, node3) = |
350 | 39f0eea5 | Iustin Pop | case Container.elems nl of |
351 | 39f0eea5 | Iustin Pop | [a, b, c] -> (a, b, c) |
352 | 39f0eea5 | Iustin Pop | l -> error $ "Invalid node list out of makeSmallCluster/3: " ++ |
353 | 39f0eea5 | Iustin Pop | show l |
354 | e1ee7d5a | Iustin Pop | node3' = node3 { Node.group = 1 } |
355 | e1ee7d5a | Iustin Pop | nl' = Container.add (Node.idx node3') node3' nl |
356 | e1ee7d5a | Iustin Pop | inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2) |
357 | e1ee7d5a | Iustin Pop | inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary |
358 | e1ee7d5a | Iustin Pop | inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3) |
359 | e1ee7d5a | Iustin Pop | ccheck = Cluster.findSplitInstances nl' . Container.fromList |
360 | e1ee7d5a | Iustin Pop | in null (ccheck [(0, inst1)]) && |
361 | e1ee7d5a | Iustin Pop | null (ccheck [(0, inst2)]) && |
362 | e1ee7d5a | Iustin Pop | (not . null $ ccheck [(0, inst3)]) |
363 | e1ee7d5a | Iustin Pop | |
364 | e1ee7d5a | Iustin Pop | -- | For now, we only test that we don't lose instances during the split. |
365 | 20bc5360 | Iustin Pop | prop_SplitCluster :: Node.Node -> Instance.Instance -> Property |
366 | 20bc5360 | Iustin Pop | prop_SplitCluster node inst = |
367 | e1ee7d5a | Iustin Pop | forAll (choose (0, 100)) $ \icnt -> |
368 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node 2 |
369 | e1ee7d5a | Iustin Pop | (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1) |
370 | e1ee7d5a | Iustin Pop | (nl, Container.empty) [1..icnt] |
371 | e1ee7d5a | Iustin Pop | gni = Cluster.splitCluster nl' il' |
372 | e1ee7d5a | Iustin Pop | in sum (map (Container.size . snd . snd) gni) == icnt && |
373 | e1ee7d5a | Iustin Pop | all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group) |
374 | e1ee7d5a | Iustin Pop | (Container.elems nl'')) gni |
375 | e1ee7d5a | Iustin Pop | |
376 | e1ee7d5a | Iustin Pop | -- | Helper function to check if we can allocate an instance on a |
377 | 9e679143 | Iustin Pop | -- given node list. Successful allocation is denoted by 'Nothing', |
378 | 9e679143 | Iustin Pop | -- otherwise the 'Just' value will contain the error message. |
379 | 9e679143 | Iustin Pop | canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String |
380 | e1ee7d5a | Iustin Pop | canAllocOn nl reqnodes inst = |
381 | e1ee7d5a | Iustin Pop | case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
382 | 5b11f8db | Iustin Pop | Cluster.tryAlloc nl Container.empty inst of |
383 | 01e52493 | Iustin Pop | Bad msg -> Just $ "Can't allocate: " ++ msg |
384 | 01e52493 | Iustin Pop | Ok as -> |
385 | e1ee7d5a | Iustin Pop | case Cluster.asSolution as of |
386 | 9e679143 | Iustin Pop | Nothing -> Just $ "No allocation solution; failures: " ++ |
387 | 9e679143 | Iustin Pop | show (Cluster.collapseFailures $ Cluster.asFailures as) |
388 | 9e679143 | Iustin Pop | Just _ -> Nothing |
389 | e1ee7d5a | Iustin Pop | |
390 | e1ee7d5a | Iustin Pop | -- | Checks that allocation obeys minimum and maximum instance |
391 | e1ee7d5a | Iustin Pop | -- policies. The unittest generates a random node, duplicates it /count/ |
392 | e1ee7d5a | Iustin Pop | -- times, and generates a random instance that can be allocated on |
393 | e1ee7d5a | Iustin Pop | -- this mini-cluster; it then checks that after applying a policy that |
394 | e1ee7d5a | Iustin Pop | -- the instance doesn't fits, the allocation fails. |
395 | 9e679143 | Iustin Pop | prop_AllocPolicy :: Property |
396 | 9e679143 | Iustin Pop | prop_AllocPolicy = |
397 | 9e679143 | Iustin Pop | forAll genOnlineNode $ \node -> |
398 | e1ee7d5a | Iustin Pop | forAll (choose (5, 20)) $ \count -> |
399 | 9e679143 | Iustin Pop | forAll (genInstanceSmallerThanNode node) $ \inst -> |
400 | a8038349 | Iustin Pop | forAll (arbitrary `suchThat` (isBad . |
401 | e1ee7d5a | Iustin Pop | Instance.instMatchesPolicy inst)) $ \ipol -> |
402 | 9e679143 | Iustin Pop | let rqn = Instance.requiredNodes $ Instance.diskTemplate inst |
403 | 9e679143 | Iustin Pop | node' = Node.setPolicy ipol node |
404 | e1ee7d5a | Iustin Pop | nl = makeSmallCluster node' count |
405 | 9e679143 | Iustin Pop | in printTestCase "Allocation check:" |
406 | 9e679143 | Iustin Pop | (isNothing (canAllocOn (makeSmallCluster node count) rqn inst)) .&&. |
407 | 9e679143 | Iustin Pop | printTestCase "Policy failure check:" (isJust $ canAllocOn nl rqn inst) |
408 | e1ee7d5a | Iustin Pop | |
409 | e09c1fa0 | Iustin Pop | testSuite "HTools/Cluster" |
410 | 20bc5360 | Iustin Pop | [ 'prop_Score_Zero |
411 | 20bc5360 | Iustin Pop | , 'prop_CStats_sane |
412 | 20bc5360 | Iustin Pop | , 'prop_Alloc_sane |
413 | d83903ee | Iustin Pop | , 'prop_IterateAlloc_sane |
414 | 20bc5360 | Iustin Pop | , 'prop_CanTieredAlloc |
415 | 20bc5360 | Iustin Pop | , 'prop_AllocRelocate |
416 | 20bc5360 | Iustin Pop | , 'prop_AllocEvacuate |
417 | 20bc5360 | Iustin Pop | , 'prop_AllocChangeGroup |
418 | 20bc5360 | Iustin Pop | , 'prop_AllocBalance |
419 | 20bc5360 | Iustin Pop | , 'prop_CheckConsistency |
420 | 20bc5360 | Iustin Pop | , 'prop_SplitCluster |
421 | 20bc5360 | Iustin Pop | , 'prop_AllocPolicy |
422 | e1ee7d5a | Iustin Pop | ] |