root / test / hs / Test / Ganeti / HTools / Cluster.hs @ 09d8b0fc
History | View | Annotate | Download (16.1 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 | 50c302ca | Guido Trotter | , genInstanceMaybeBiggerThanNode ) |
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 | 09d8b0fc | Klaus Aehlig | -- | Check that one instance is allocated correctly on an empty cluster, |
130 | 09d8b0fc | Klaus Aehlig | -- without 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 | e1ee7d5a | Iustin Pop | -- | Checks that on a 2-5 node cluster, we can allocate a random |
152 | e1ee7d5a | Iustin Pop | -- instance spec via tiered allocation (whatever the original instance |
153 | e1ee7d5a | Iustin Pop | -- spec), on either one or two nodes. Furthermore, we test that |
154 | e1ee7d5a | Iustin Pop | -- computed allocation statistics are correct. |
155 | fb243105 | Iustin Pop | prop_CanTieredAlloc :: Property |
156 | fb243105 | Iustin Pop | prop_CanTieredAlloc = |
157 | e1ee7d5a | Iustin Pop | forAll (choose (2, 5)) $ \count -> |
158 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
159 | 50c302ca | Guido Trotter | forAll (genInstanceMaybeBiggerThanNode node) $ \inst -> |
160 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
161 | e1ee7d5a | Iustin Pop | il = Container.empty |
162 | e1ee7d5a | Iustin Pop | rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
163 | e1ee7d5a | Iustin Pop | allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True |
164 | e1ee7d5a | Iustin Pop | in case allocnodes >>= \allocnodes' -> |
165 | fb243105 | Iustin Pop | Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of |
166 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg |
167 | 01e52493 | Iustin Pop | Ok (_, nl', il', ixes, cstats) -> |
168 | e1ee7d5a | Iustin Pop | let (ai_alloc, ai_pool, ai_unav) = |
169 | e1ee7d5a | Iustin Pop | Cluster.computeAllocationDelta |
170 | e1ee7d5a | Iustin Pop | (Cluster.totalResources nl) |
171 | e1ee7d5a | Iustin Pop | (Cluster.totalResources nl') |
172 | fb243105 | Iustin Pop | all_nodes fn = sum $ map fn (Container.elems nl) |
173 | fb243105 | Iustin Pop | all_res fn = sum $ map fn [ai_alloc, ai_pool, ai_unav] |
174 | fb243105 | Iustin Pop | in conjoin |
175 | fb243105 | Iustin Pop | [ printTestCase "No instances allocated" $ not (null ixes) |
176 | fb243105 | Iustin Pop | , IntMap.size il' ==? length ixes |
177 | fb243105 | Iustin Pop | , length ixes ==? length cstats |
178 | fb243105 | Iustin Pop | , all_res Types.allocInfoVCpus ==? all_nodes Node.hiCpu |
179 | fb243105 | Iustin Pop | , all_res Types.allocInfoNCpus ==? all_nodes Node.tCpu |
180 | fb243105 | Iustin Pop | , all_res Types.allocInfoMem ==? truncate (all_nodes Node.tMem) |
181 | fb243105 | Iustin Pop | , all_res Types.allocInfoDisk ==? truncate (all_nodes Node.tDsk) |
182 | fb243105 | Iustin Pop | ] |
183 | e1ee7d5a | Iustin Pop | |
184 | e1ee7d5a | Iustin Pop | -- | Helper function to create a cluster with the given range of nodes |
185 | e1ee7d5a | Iustin Pop | -- and allocate an instance on it. |
186 | e1ee7d5a | Iustin Pop | genClusterAlloc :: Int -> Node.Node -> Instance.Instance |
187 | 01e52493 | Iustin Pop | -> Result (Node.List, Instance.List, Instance.Instance) |
188 | e1ee7d5a | Iustin Pop | genClusterAlloc count node inst = |
189 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
190 | e1ee7d5a | Iustin Pop | reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst |
191 | e1ee7d5a | Iustin Pop | in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
192 | e1ee7d5a | Iustin Pop | Cluster.tryAlloc nl Container.empty inst of |
193 | 01e52493 | Iustin Pop | Bad msg -> Bad $ "Can't allocate: " ++ msg |
194 | 01e52493 | Iustin Pop | Ok as -> |
195 | e1ee7d5a | Iustin Pop | case Cluster.asSolution as of |
196 | 01e52493 | Iustin Pop | Nothing -> Bad "Empty solution?" |
197 | e1ee7d5a | Iustin Pop | Just (xnl, xi, _, _) -> |
198 | e1ee7d5a | Iustin Pop | let xil = Container.add (Instance.idx xi) xi Container.empty |
199 | 01e52493 | Iustin Pop | in Ok (xnl, xil, xi) |
200 | e1ee7d5a | Iustin Pop | |
201 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster, once we allocate an instance, |
202 | e1ee7d5a | Iustin Pop | -- we can also relocate it. |
203 | 20bc5360 | Iustin Pop | prop_AllocRelocate :: Property |
204 | 20bc5360 | Iustin Pop | prop_AllocRelocate = |
205 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
206 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
207 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
208 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
209 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
210 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
211 | e1ee7d5a | Iustin Pop | case IAlloc.processRelocate defGroupList nl il |
212 | e1ee7d5a | Iustin Pop | (Instance.idx inst) 1 |
213 | e1ee7d5a | Iustin Pop | [(if Instance.diskTemplate inst' == Types.DTDrbd8 |
214 | e1ee7d5a | Iustin Pop | then Instance.sNode |
215 | e1ee7d5a | Iustin Pop | else Instance.pNode) inst'] of |
216 | 01e52493 | Iustin Pop | Ok _ -> passTest |
217 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to relocate: " ++ msg |
218 | e1ee7d5a | Iustin Pop | |
219 | e1ee7d5a | Iustin Pop | -- | Helper property checker for the result of a nodeEvac or |
220 | e1ee7d5a | Iustin Pop | -- changeGroup operation. |
221 | e1ee7d5a | Iustin Pop | check_EvacMode :: Group.Group -> Instance.Instance |
222 | 01e52493 | Iustin Pop | -> Result (Node.List, Instance.List, Cluster.EvacSolution) |
223 | e1ee7d5a | Iustin Pop | -> Property |
224 | e1ee7d5a | Iustin Pop | check_EvacMode grp inst result = |
225 | e1ee7d5a | Iustin Pop | case result of |
226 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg |
227 | 01e52493 | Iustin Pop | Ok (_, _, es) -> |
228 | e1ee7d5a | Iustin Pop | let moved = Cluster.esMoved es |
229 | e1ee7d5a | Iustin Pop | failed = Cluster.esFailed es |
230 | e1ee7d5a | Iustin Pop | opcodes = not . null $ Cluster.esOpCodes es |
231 | 942a9a6a | Iustin Pop | in conjoin |
232 | 942a9a6a | Iustin Pop | [ failmsg ("'failed' not empty: " ++ show failed) (null failed) |
233 | 942a9a6a | Iustin Pop | , failmsg "'opcodes' is null" opcodes |
234 | 942a9a6a | Iustin Pop | , case moved of |
235 | 942a9a6a | Iustin Pop | [(idx', gdx, _)] -> |
236 | 942a9a6a | Iustin Pop | failmsg "invalid instance moved" (idx == idx') .&&. |
237 | 942a9a6a | Iustin Pop | failmsg "wrong target group" (gdx == Group.idx grp) |
238 | 942a9a6a | Iustin Pop | v -> failmsg ("invalid solution: " ++ show v) False |
239 | 942a9a6a | Iustin Pop | ] |
240 | e1ee7d5a | Iustin Pop | where failmsg :: String -> Bool -> Property |
241 | 5b11f8db | Iustin Pop | failmsg msg = printTestCase ("Failed to evacuate: " ++ msg) |
242 | e1ee7d5a | Iustin Pop | idx = Instance.idx inst |
243 | e1ee7d5a | Iustin Pop | |
244 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster, once we allocate an instance, |
245 | e1ee7d5a | Iustin Pop | -- we can also node-evacuate it. |
246 | 20bc5360 | Iustin Pop | prop_AllocEvacuate :: Property |
247 | 20bc5360 | Iustin Pop | prop_AllocEvacuate = |
248 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
249 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
250 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
251 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
252 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
253 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
254 | e1ee7d5a | Iustin Pop | conjoin . map (\mode -> check_EvacMode defGroup inst' $ |
255 | e1ee7d5a | Iustin Pop | Cluster.tryNodeEvac defGroupList nl il mode |
256 | e1ee7d5a | Iustin Pop | [Instance.idx inst']) . |
257 | e1ee7d5a | Iustin Pop | evacModeOptions . |
258 | e1ee7d5a | Iustin Pop | Instance.mirrorType $ inst' |
259 | e1ee7d5a | Iustin Pop | |
260 | e1ee7d5a | Iustin Pop | -- | Checks that on a 4-8 node cluster with two node groups, once we |
261 | e1ee7d5a | Iustin Pop | -- allocate an instance on the first node group, we can also change |
262 | e1ee7d5a | Iustin Pop | -- its group. |
263 | 20bc5360 | Iustin Pop | prop_AllocChangeGroup :: Property |
264 | 20bc5360 | Iustin Pop | prop_AllocChangeGroup = |
265 | e1ee7d5a | Iustin Pop | forAll (choose (4, 8)) $ \count -> |
266 | 5b11f8db | Iustin Pop | forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> |
267 | e1ee7d5a | Iustin Pop | forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> |
268 | e1ee7d5a | Iustin Pop | case genClusterAlloc count node inst of |
269 | 01e52493 | Iustin Pop | Bad msg -> failTest msg |
270 | 01e52493 | Iustin Pop | Ok (nl, il, inst') -> |
271 | e1ee7d5a | Iustin Pop | -- we need to add a second node group and nodes to the cluster |
272 | e1ee7d5a | Iustin Pop | let nl2 = Container.elems $ makeSmallCluster node count |
273 | e1ee7d5a | Iustin Pop | grp2 = Group.setIdx defGroup (Group.idx defGroup + 1) |
274 | e1ee7d5a | Iustin Pop | maxndx = maximum . map Node.idx $ nl2 |
275 | e1ee7d5a | Iustin Pop | nl3 = map (\n -> n { Node.group = Group.idx grp2 |
276 | e1ee7d5a | Iustin Pop | , Node.idx = Node.idx n + maxndx }) nl2 |
277 | e1ee7d5a | Iustin Pop | nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3 |
278 | e1ee7d5a | Iustin Pop | gl' = Container.add (Group.idx grp2) grp2 defGroupList |
279 | e1ee7d5a | Iustin Pop | nl' = IntMap.union nl nl4 |
280 | e1ee7d5a | Iustin Pop | in check_EvacMode grp2 inst' $ |
281 | e1ee7d5a | Iustin Pop | Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst'] |
282 | e1ee7d5a | Iustin Pop | |
283 | e1ee7d5a | Iustin Pop | -- | Check that allocating multiple instances on a cluster, then |
284 | e1ee7d5a | Iustin Pop | -- adding an empty node, results in a valid rebalance. |
285 | 20bc5360 | Iustin Pop | prop_AllocBalance :: Property |
286 | 20bc5360 | Iustin Pop | prop_AllocBalance = |
287 | e1ee7d5a | Iustin Pop | forAll (genNode (Just 5) (Just 128)) $ \node -> |
288 | e1ee7d5a | Iustin Pop | forAll (choose (3, 5)) $ \count -> |
289 | e1ee7d5a | Iustin Pop | not (Node.offline node) && not (Node.failN1 node) ==> |
290 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node count |
291 | b9612abb | Iustin Pop | hnode = snd $ IntMap.findMax nl |
292 | b9612abb | Iustin Pop | nl' = IntMap.deleteMax nl |
293 | e1ee7d5a | Iustin Pop | il = Container.empty |
294 | e1ee7d5a | Iustin Pop | allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True |
295 | e1ee7d5a | Iustin Pop | i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu |
296 | e1ee7d5a | Iustin Pop | in case allocnodes >>= \allocnodes' -> |
297 | e1ee7d5a | Iustin Pop | Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of |
298 | 01e52493 | Iustin Pop | Bad msg -> failTest $ "Failed to allocate: " ++ msg |
299 | 01e52493 | Iustin Pop | Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances" |
300 | 01e52493 | Iustin Pop | Ok (_, xnl, il', _, _) -> |
301 | e1ee7d5a | Iustin Pop | let ynl = Container.add (Node.idx hnode) hnode xnl |
302 | e1ee7d5a | Iustin Pop | cv = Cluster.compCV ynl |
303 | e1ee7d5a | Iustin Pop | tbl = Cluster.Table ynl il' cv [] |
304 | e1ee7d5a | Iustin Pop | in printTestCase "Failed to rebalance" $ |
305 | e1ee7d5a | Iustin Pop | canBalance tbl True True False |
306 | e1ee7d5a | Iustin Pop | |
307 | e1ee7d5a | Iustin Pop | -- | Checks consistency. |
308 | 20bc5360 | Iustin Pop | prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool |
309 | 20bc5360 | Iustin Pop | prop_CheckConsistency node inst = |
310 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node 3 |
311 | 39f0eea5 | Iustin Pop | (node1, node2, node3) = |
312 | 39f0eea5 | Iustin Pop | case Container.elems nl of |
313 | 39f0eea5 | Iustin Pop | [a, b, c] -> (a, b, c) |
314 | 39f0eea5 | Iustin Pop | l -> error $ "Invalid node list out of makeSmallCluster/3: " ++ |
315 | 39f0eea5 | Iustin Pop | show l |
316 | e1ee7d5a | Iustin Pop | node3' = node3 { Node.group = 1 } |
317 | e1ee7d5a | Iustin Pop | nl' = Container.add (Node.idx node3') node3' nl |
318 | e1ee7d5a | Iustin Pop | inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2) |
319 | e1ee7d5a | Iustin Pop | inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary |
320 | e1ee7d5a | Iustin Pop | inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3) |
321 | e1ee7d5a | Iustin Pop | ccheck = Cluster.findSplitInstances nl' . Container.fromList |
322 | e1ee7d5a | Iustin Pop | in null (ccheck [(0, inst1)]) && |
323 | e1ee7d5a | Iustin Pop | null (ccheck [(0, inst2)]) && |
324 | e1ee7d5a | Iustin Pop | (not . null $ ccheck [(0, inst3)]) |
325 | e1ee7d5a | Iustin Pop | |
326 | e1ee7d5a | Iustin Pop | -- | For now, we only test that we don't lose instances during the split. |
327 | 20bc5360 | Iustin Pop | prop_SplitCluster :: Node.Node -> Instance.Instance -> Property |
328 | 20bc5360 | Iustin Pop | prop_SplitCluster node inst = |
329 | e1ee7d5a | Iustin Pop | forAll (choose (0, 100)) $ \icnt -> |
330 | e1ee7d5a | Iustin Pop | let nl = makeSmallCluster node 2 |
331 | e1ee7d5a | Iustin Pop | (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1) |
332 | e1ee7d5a | Iustin Pop | (nl, Container.empty) [1..icnt] |
333 | e1ee7d5a | Iustin Pop | gni = Cluster.splitCluster nl' il' |
334 | e1ee7d5a | Iustin Pop | in sum (map (Container.size . snd . snd) gni) == icnt && |
335 | e1ee7d5a | Iustin Pop | all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group) |
336 | e1ee7d5a | Iustin Pop | (Container.elems nl'')) gni |
337 | e1ee7d5a | Iustin Pop | |
338 | e1ee7d5a | Iustin Pop | -- | Helper function to check if we can allocate an instance on a |
339 | 9e679143 | Iustin Pop | -- given node list. Successful allocation is denoted by 'Nothing', |
340 | 9e679143 | Iustin Pop | -- otherwise the 'Just' value will contain the error message. |
341 | 9e679143 | Iustin Pop | canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String |
342 | e1ee7d5a | Iustin Pop | canAllocOn nl reqnodes inst = |
343 | e1ee7d5a | Iustin Pop | case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
344 | 5b11f8db | Iustin Pop | Cluster.tryAlloc nl Container.empty inst of |
345 | 01e52493 | Iustin Pop | Bad msg -> Just $ "Can't allocate: " ++ msg |
346 | 01e52493 | Iustin Pop | Ok as -> |
347 | e1ee7d5a | Iustin Pop | case Cluster.asSolution as of |
348 | 9e679143 | Iustin Pop | Nothing -> Just $ "No allocation solution; failures: " ++ |
349 | 9e679143 | Iustin Pop | show (Cluster.collapseFailures $ Cluster.asFailures as) |
350 | 9e679143 | Iustin Pop | Just _ -> Nothing |
351 | e1ee7d5a | Iustin Pop | |
352 | e1ee7d5a | Iustin Pop | -- | Checks that allocation obeys minimum and maximum instance |
353 | e1ee7d5a | Iustin Pop | -- policies. The unittest generates a random node, duplicates it /count/ |
354 | e1ee7d5a | Iustin Pop | -- times, and generates a random instance that can be allocated on |
355 | e1ee7d5a | Iustin Pop | -- this mini-cluster; it then checks that after applying a policy that |
356 | e1ee7d5a | Iustin Pop | -- the instance doesn't fits, the allocation fails. |
357 | 9e679143 | Iustin Pop | prop_AllocPolicy :: Property |
358 | 9e679143 | Iustin Pop | prop_AllocPolicy = |
359 | 9e679143 | Iustin Pop | forAll genOnlineNode $ \node -> |
360 | e1ee7d5a | Iustin Pop | forAll (choose (5, 20)) $ \count -> |
361 | 9e679143 | Iustin Pop | forAll (genInstanceSmallerThanNode node) $ \inst -> |
362 | a8038349 | Iustin Pop | forAll (arbitrary `suchThat` (isBad . |
363 | e1ee7d5a | Iustin Pop | Instance.instMatchesPolicy inst)) $ \ipol -> |
364 | 9e679143 | Iustin Pop | let rqn = Instance.requiredNodes $ Instance.diskTemplate inst |
365 | 9e679143 | Iustin Pop | node' = Node.setPolicy ipol node |
366 | e1ee7d5a | Iustin Pop | nl = makeSmallCluster node' count |
367 | 9e679143 | Iustin Pop | in printTestCase "Allocation check:" |
368 | 9e679143 | Iustin Pop | (isNothing (canAllocOn (makeSmallCluster node count) rqn inst)) .&&. |
369 | 9e679143 | Iustin Pop | printTestCase "Policy failure check:" (isJust $ canAllocOn nl rqn inst) |
370 | e1ee7d5a | Iustin Pop | |
371 | e09c1fa0 | Iustin Pop | testSuite "HTools/Cluster" |
372 | 20bc5360 | Iustin Pop | [ 'prop_Score_Zero |
373 | 20bc5360 | Iustin Pop | , 'prop_CStats_sane |
374 | 20bc5360 | Iustin Pop | , 'prop_Alloc_sane |
375 | d83903ee | Iustin Pop | , 'prop_IterateAlloc_sane |
376 | 20bc5360 | Iustin Pop | , 'prop_CanTieredAlloc |
377 | 20bc5360 | Iustin Pop | , 'prop_AllocRelocate |
378 | 20bc5360 | Iustin Pop | , 'prop_AllocEvacuate |
379 | 20bc5360 | Iustin Pop | , 'prop_AllocChangeGroup |
380 | 20bc5360 | Iustin Pop | , 'prop_AllocBalance |
381 | 20bc5360 | Iustin Pop | , 'prop_CheckConsistency |
382 | 20bc5360 | Iustin Pop | , 'prop_SplitCluster |
383 | 20bc5360 | Iustin Pop | , 'prop_AllocPolicy |
384 | e1ee7d5a | Iustin Pop | ] |