| 36 |
36 |
import Test.Ganeti.TestHelper
|
| 37 |
37 |
import Test.Ganeti.TestCommon
|
| 38 |
38 |
import Test.Ganeti.TestHTools
|
| 39 |
|
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
|
|
39 |
import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
|
|
40 |
, genInstanceSmallerThan )
|
| 40 |
41 |
import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
|
| 41 |
42 |
|
| 42 |
43 |
import qualified Ganeti.HTools.Cluster as Cluster
|
| ... | ... | |
| 185 |
186 |
-- instance spec via tiered allocation (whatever the original instance
|
| 186 |
187 |
-- spec), on either one or two nodes. Furthermore, we test that
|
| 187 |
188 |
-- computed allocation statistics are correct.
|
| 188 |
|
prop_CanTieredAlloc :: Instance.Instance -> Property
|
| 189 |
|
prop_CanTieredAlloc inst =
|
|
189 |
prop_CanTieredAlloc :: Property
|
|
190 |
prop_CanTieredAlloc =
|
| 190 |
191 |
forAll (choose (2, 5)) $ \count ->
|
| 191 |
192 |
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
|
|
193 |
forAll (genInstanceSmallerThan
|
|
194 |
(Node.availMem node + Types.unitMem * 2)
|
|
195 |
(Node.availDisk node + Types.unitDsk * 3)
|
|
196 |
(Node.availCpu node + Types.unitCpu * 4)) $ \inst ->
|
| 192 |
197 |
let nl = makeSmallCluster node count
|
| 193 |
198 |
il = Container.empty
|
| 194 |
199 |
rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
|
| 195 |
200 |
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
|
| 196 |
201 |
in case allocnodes >>= \allocnodes' ->
|
| 197 |
|
Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
|
|
202 |
Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
|
| 198 |
203 |
Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
|
| 199 |
204 |
Types.Ok (_, nl', il', ixes, cstats) ->
|
| 200 |
205 |
let (ai_alloc, ai_pool, ai_unav) =
|
| 201 |
206 |
Cluster.computeAllocationDelta
|
| 202 |
207 |
(Cluster.totalResources nl)
|
| 203 |
208 |
(Cluster.totalResources nl')
|
| 204 |
|
all_nodes = Container.elems nl
|
| 205 |
|
in property (not (null ixes)) .&&.
|
| 206 |
|
IntMap.size il' ==? length ixes .&&.
|
| 207 |
|
length ixes ==? length cstats .&&.
|
| 208 |
|
sum (map Types.allocInfoVCpus [ai_alloc, ai_pool, ai_unav]) ==?
|
| 209 |
|
sum (map Node.hiCpu all_nodes) .&&.
|
| 210 |
|
sum (map Types.allocInfoNCpus [ai_alloc, ai_pool, ai_unav]) ==?
|
| 211 |
|
sum (map Node.tCpu all_nodes) .&&.
|
| 212 |
|
sum (map Types.allocInfoMem [ai_alloc, ai_pool, ai_unav]) ==?
|
| 213 |
|
truncate (sum (map Node.tMem all_nodes)) .&&.
|
| 214 |
|
sum (map Types.allocInfoDisk [ai_alloc, ai_pool, ai_unav]) ==?
|
| 215 |
|
truncate (sum (map Node.tDsk all_nodes))
|
|
209 |
all_nodes fn = sum $ map fn (Container.elems nl)
|
|
210 |
all_res fn = sum $ map fn [ai_alloc, ai_pool, ai_unav]
|
|
211 |
in conjoin
|
|
212 |
[ printTestCase "No instances allocated" $ not (null ixes)
|
|
213 |
, IntMap.size il' ==? length ixes
|
|
214 |
, length ixes ==? length cstats
|
|
215 |
, all_res Types.allocInfoVCpus ==? all_nodes Node.hiCpu
|
|
216 |
, all_res Types.allocInfoNCpus ==? all_nodes Node.tCpu
|
|
217 |
, all_res Types.allocInfoMem ==? truncate (all_nodes Node.tMem)
|
|
218 |
, all_res Types.allocInfoDisk ==? truncate (all_nodes Node.tDsk)
|
|
219 |
]
|
| 216 |
220 |
|
| 217 |
221 |
-- | Helper function to create a cluster with the given range of nodes
|
| 218 |
222 |
-- and allocate an instance on it.
|