Revision 525bfb36 htools/Ganeti/HTools/QC.hs
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
1 |
{-| Unittests for ganeti-htools |
|
1 |
{-| Unittests for ganeti-htools.
|
|
2 | 2 |
|
3 | 3 |
-} |
4 | 4 |
|
... | ... | |
70 | 70 |
|
71 | 71 |
-- * Constants |
72 | 72 |
|
73 |
-- | Maximum memory (1TiB, somewhat random value) |
|
73 |
-- | Maximum memory (1TiB, somewhat random value).
|
|
74 | 74 |
maxMem :: Int |
75 | 75 |
maxMem = 1024 * 1024 |
76 | 76 |
|
77 |
-- | Maximum disk (8TiB, somewhat random value) |
|
77 |
-- | Maximum disk (8TiB, somewhat random value).
|
|
78 | 78 |
maxDsk :: Int |
79 | 79 |
maxDsk = 1024 * 1024 * 8 |
80 | 80 |
|
81 |
-- | Max CPUs (1024, somewhat random value) |
|
81 |
-- | Max CPUs (1024, somewhat random value).
|
|
82 | 82 |
maxCpu :: Int |
83 | 83 |
maxCpu = 1024 |
84 | 84 |
|
... | ... | |
95 | 95 |
|
96 | 96 |
-- * Helper functions |
97 | 97 |
|
98 |
-- | Simple checker for whether OpResult is fail or pass |
|
98 |
-- | Simple checker for whether OpResult is fail or pass.
|
|
99 | 99 |
isFailure :: Types.OpResult a -> Bool |
100 | 100 |
isFailure (Types.OpFail _) = True |
101 | 101 |
isFailure _ = False |
102 | 102 |
|
103 |
-- | Update an instance to be smaller than a node |
|
103 |
-- | Update an instance to be smaller than a node.
|
|
104 | 104 |
setInstanceSmallerThanNode node inst = |
105 | 105 |
inst { Instance.mem = Node.availMem node `div` 2 |
106 | 106 |
, Instance.dsk = Node.availDisk node `div` 2 |
107 | 107 |
, Instance.vcpus = Node.availCpu node `div` 2 |
108 | 108 |
} |
109 | 109 |
|
110 |
-- | Create an instance given its spec |
|
110 |
-- | Create an instance given its spec.
|
|
111 | 111 |
createInstance mem dsk vcpus = |
112 | 112 |
Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1) |
113 | 113 |
|
114 |
-- | Create a small cluster by repeating a node spec |
|
114 |
-- | Create a small cluster by repeating a node spec.
|
|
115 | 115 |
makeSmallCluster :: Node.Node -> Int -> Node.List |
116 | 116 |
makeSmallCluster node count = |
117 | 117 |
let fn = Node.buildPeers node Container.empty |
... | ... | |
119 | 119 |
(_, nlst) = Loader.assignIndices namelst |
120 | 120 |
in nlst |
121 | 121 |
|
122 |
-- | Checks if a node is "big" enough |
|
122 |
-- | Checks if a node is "big" enough.
|
|
123 | 123 |
isNodeBig :: Node.Node -> Int -> Bool |
124 | 124 |
isNodeBig node size = Node.availDisk node > size * Types.unitDsk |
125 | 125 |
&& Node.availMem node > size * Types.unitMem |
... | ... | |
129 | 129 |
canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0 |
130 | 130 |
|
131 | 131 |
-- | Assigns a new fresh instance to a cluster; this is not |
132 |
-- allocation, so no resource checks are done |
|
132 |
-- allocation, so no resource checks are done.
|
|
133 | 133 |
assignInstance :: Node.List -> Instance.List -> Instance.Instance -> |
134 | 134 |
Types.Idx -> Types.Idx -> |
135 | 135 |
(Node.List, Instance.List) |
... | ... | |
149 | 149 |
|
150 | 150 |
-- * Arbitrary instances |
151 | 151 |
|
152 |
-- | Defines a DNS name. |
|
152 | 153 |
newtype DNSChar = DNSChar { dnsGetChar::Char } |
154 |
|
|
153 | 155 |
instance Arbitrary DNSChar where |
154 | 156 |
arbitrary = do |
155 | 157 |
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-") |
... | ... | |
189 | 191 |
vcpus <- choose (0, maxCpu) |
190 | 192 |
return $ Instance.create name mem dsk vcpus run_st [] True pn sn |
191 | 193 |
|
192 |
genNode :: Maybe Int -> Maybe Int -> Gen Node.Node |
|
194 |
-- | Generas an arbitrary node based on sizing information. |
|
195 |
genNode :: Maybe Int -- ^ Minimum node size in terms of units |
|
196 |
-> Maybe Int -- ^ Maximum node size (when Nothing, bounded |
|
197 |
-- just by the max... constants) |
|
198 |
-> Gen Node.Node |
|
193 | 199 |
genNode min_multiplier max_multiplier = do |
194 | 200 |
let (base_mem, base_dsk, base_cpu) = |
195 | 201 |
case min_multiplier of |
... | ... | |
253 | 259 |
instance Arbitrary Jobs.JobStatus where |
254 | 260 |
arbitrary = elements [minBound..maxBound] |
255 | 261 |
|
262 |
newtype SmallRatio = SmallRatio Double deriving Show |
|
263 |
instance Arbitrary SmallRatio where |
|
264 |
arbitrary = do |
|
265 |
v <- choose (0, 1) |
|
266 |
return $ SmallRatio v |
|
267 |
|
|
256 | 268 |
-- * Actual tests |
257 | 269 |
|
258 |
-- If the list is not just an empty element, and if the elements do |
|
259 |
-- not contain commas, then join+split should be idepotent |
|
270 |
-- ** Utils tests |
|
271 |
|
|
272 |
-- | If the list is not just an empty element, and if the elements do |
|
273 |
-- not contain commas, then join+split should be idempotent. |
|
260 | 274 |
prop_Utils_commaJoinSplit = |
261 | 275 |
forAll (arbitrary `suchThat` |
262 | 276 |
(\l -> l /= [""] && all (not . elem ',') l )) $ \lst -> |
263 | 277 |
Utils.sepSplit ',' (Utils.commaJoin lst) == lst |
264 | 278 |
|
265 |
-- Split and join should always be idempotent
|
|
279 |
-- | Split and join should always be idempotent.
|
|
266 | 280 |
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s |
267 | 281 |
|
268 | 282 |
-- | fromObjWithDefault, we test using the Maybe monad and an integer |
269 |
-- value |
|
283 |
-- value.
|
|
270 | 284 |
prop_Utils_fromObjWithDefault def_value random_key = |
271 | 285 |
-- a missing key will be returned with the default |
272 | 286 |
Utils.fromObjWithDefault [] random_key def_value == Just def_value && |
... | ... | |
275 | 289 |
random_key (def_value+1) == Just def_value |
276 | 290 |
where _types = def_value :: Integer |
277 | 291 |
|
292 |
-- | Test list for the Utils module. |
|
278 | 293 |
testUtils = |
279 | 294 |
[ run prop_Utils_commaJoinSplit |
280 | 295 |
, run prop_Utils_commaSplitJoin |
281 | 296 |
, run prop_Utils_fromObjWithDefault |
282 | 297 |
] |
283 | 298 |
|
284 |
-- | Make sure add is idempotent |
|
299 |
-- ** PeerMap tests |
|
300 |
|
|
301 |
-- | Make sure add is idempotent. |
|
285 | 302 |
prop_PeerMap_addIdempotent pmap key em = |
286 | 303 |
fn puniq == fn (fn puniq) |
287 | 304 |
where _types = (pmap::PeerMap.PeerMap, |
... | ... | |
289 | 306 |
fn = PeerMap.add key em |
290 | 307 |
puniq = PeerMap.accumArray const pmap |
291 | 308 |
|
292 |
-- | Make sure remove is idempotent |
|
309 |
-- | Make sure remove is idempotent.
|
|
293 | 310 |
prop_PeerMap_removeIdempotent pmap key = |
294 | 311 |
fn puniq == fn (fn puniq) |
295 | 312 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
296 | 313 |
fn = PeerMap.remove key |
297 | 314 |
puniq = PeerMap.accumArray const pmap |
298 | 315 |
|
299 |
-- | Make sure a missing item returns 0 |
|
316 |
-- | Make sure a missing item returns 0.
|
|
300 | 317 |
prop_PeerMap_findMissing pmap key = |
301 | 318 |
PeerMap.find key (PeerMap.remove key puniq) == 0 |
302 | 319 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
303 | 320 |
puniq = PeerMap.accumArray const pmap |
304 | 321 |
|
305 |
-- | Make sure an added item is found |
|
322 |
-- | Make sure an added item is found.
|
|
306 | 323 |
prop_PeerMap_addFind pmap key em = |
307 | 324 |
PeerMap.find key (PeerMap.add key em puniq) == em |
308 | 325 |
where _types = (pmap::PeerMap.PeerMap, |
309 | 326 |
key::PeerMap.Key, em::PeerMap.Elem) |
310 | 327 |
puniq = PeerMap.accumArray const pmap |
311 | 328 |
|
312 |
-- | Manual check that maxElem returns the maximum indeed, or 0 for null |
|
329 |
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
|
|
313 | 330 |
prop_PeerMap_maxElem pmap = |
314 | 331 |
PeerMap.maxElem puniq == if null puniq then 0 |
315 | 332 |
else (maximum . snd . unzip) puniq |
316 | 333 |
where _types = pmap::PeerMap.PeerMap |
317 | 334 |
puniq = PeerMap.accumArray const pmap |
318 | 335 |
|
336 |
-- | List of tests for the PeerMap module. |
|
319 | 337 |
testPeerMap = |
320 | 338 |
[ run prop_PeerMap_addIdempotent |
321 | 339 |
, run prop_PeerMap_removeIdempotent |
... | ... | |
324 | 342 |
, run prop_PeerMap_findMissing |
325 | 343 |
] |
326 | 344 |
|
327 |
-- Container tests |
|
345 |
-- ** Container tests
|
|
328 | 346 |
|
329 | 347 |
prop_Container_addTwo cdata i1 i2 = |
330 | 348 |
fn i1 i2 cont == fn i2 i1 cont && |
... | ... | |
339 | 357 |
fnode = head (Container.elems nl) |
340 | 358 |
in Container.nameOf nl (Node.idx fnode) == Node.name fnode |
341 | 359 |
|
342 |
-- We test that in a cluster, given a random node, we can find it by |
|
360 |
-- | We test that in a cluster, given a random node, we can find it by
|
|
343 | 361 |
-- its name and alias, as long as all names and aliases are unique, |
344 |
-- and that we fail to find a non-existing name |
|
362 |
-- and that we fail to find a non-existing name.
|
|
345 | 363 |
prop_Container_findByName node othername = |
346 | 364 |
forAll (choose (1, 20)) $ \ cnt -> |
347 | 365 |
forAll (choose (0, cnt - 1)) $ \ fidx -> |
... | ... | |
367 | 385 |
, run prop_Container_findByName |
368 | 386 |
] |
369 | 387 |
|
388 |
-- ** Instance tests |
|
389 |
|
|
370 | 390 |
-- Simple instance tests, we only have setter/getters |
371 | 391 |
|
372 | 392 |
prop_Instance_creat inst = |
... | ... | |
471 | 491 |
, run prop_Instance_setMovable |
472 | 492 |
] |
473 | 493 |
|
494 |
-- ** Text backend tests |
|
495 |
|
|
474 | 496 |
-- Instance text loader tests |
475 | 497 |
|
476 | 498 |
prop_Text_Load_Instance name mem dsk vcpus status |
... | ... | |
565 | 587 |
, run prop_Text_NodeLSIdempotent |
566 | 588 |
] |
567 | 589 |
|
568 |
-- Node tests |
|
590 |
-- ** Node tests
|
|
569 | 591 |
|
570 | 592 |
prop_Node_setAlias node name = |
571 | 593 |
Node.name newnode == Node.name node && |
... | ... | |
585 | 607 |
Node.mCpu newnode == mc |
586 | 608 |
where newnode = Node.setMcpu node mc |
587 | 609 |
|
588 |
-- | Check that an instance add with too high memory or disk will be rejected |
|
610 |
-- | Check that an instance add with too high memory or disk will be |
|
611 |
-- rejected. |
|
589 | 612 |
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node && |
590 | 613 |
not (Node.failN1 node) |
591 | 614 |
==> |
... | ... | |
615 | 638 |
inst' = setInstanceSmallerThanNode node inst |
616 | 639 |
inst'' = inst' { Instance.vcpus = Node.availCpu node + extra } |
617 | 640 |
|
618 |
-- | Check that an instance add with too high memory or disk will be rejected |
|
641 |
-- | Check that an instance add with too high memory or disk will be |
|
642 |
-- rejected. |
|
619 | 643 |
prop_Node_addSec node inst pdx = |
620 | 644 |
(Instance.mem inst >= (Node.fMem node - Node.rMem node) || |
621 | 645 |
Instance.dsk inst >= Node.fDsk node) && |
... | ... | |
623 | 647 |
==> isFailure (Node.addSec node inst pdx) |
624 | 648 |
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) |
625 | 649 |
|
626 |
-- | Checks for memory reservation changes |
|
650 |
-- | Checks for memory reservation changes.
|
|
627 | 651 |
prop_Node_rMem inst = |
628 | 652 |
forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node -> |
629 | 653 |
-- ab = auto_balance, nb = non-auto_balance |
... | ... | |
655 | 679 |
x -> printTestCase ("Failed to add/remove instances: " ++ show x) |
656 | 680 |
False |
657 | 681 |
|
658 |
newtype SmallRatio = SmallRatio Double deriving Show |
|
659 |
instance Arbitrary SmallRatio where |
|
660 |
arbitrary = do |
|
661 |
v <- choose (0, 1) |
|
662 |
return $ SmallRatio v |
|
663 |
|
|
664 |
-- | Check mdsk setting |
|
682 |
-- | Check mdsk setting. |
|
665 | 683 |
prop_Node_setMdsk node mx = |
666 | 684 |
Node.loDsk node' >= 0 && |
667 | 685 |
fromIntegral (Node.loDsk node') <= Node.tDsk node && |
... | ... | |
715 | 733 |
] |
716 | 734 |
|
717 | 735 |
|
718 |
-- Cluster tests |
|
736 |
-- ** Cluster tests
|
|
719 | 737 |
|
720 |
-- | Check that the cluster score is close to zero for a homogeneous cluster |
|
738 |
-- | Check that the cluster score is close to zero for a homogeneous |
|
739 |
-- cluster. |
|
721 | 740 |
prop_Score_Zero node = |
722 | 741 |
forAll (choose (1, 1024)) $ \count -> |
723 | 742 |
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) && |
... | ... | |
730 | 749 |
-- this should be much lower than the default score in CLI.hs |
731 | 750 |
in score <= 1e-12 |
732 | 751 |
|
733 |
-- | Check that cluster stats are sane |
|
752 |
-- | Check that cluster stats are sane.
|
|
734 | 753 |
prop_CStats_sane node = |
735 | 754 |
forAll (choose (1, 1024)) $ \count -> |
736 | 755 |
(not (Node.offline node) && not (Node.failN1 node) && |
... | ... | |
743 | 762 |
Cluster.csAdsk cstats <= Cluster.csFdsk cstats |
744 | 763 |
|
745 | 764 |
-- | Check that one instance is allocated correctly, without |
746 |
-- rebalances needed |
|
765 |
-- rebalances needed.
|
|
747 | 766 |
prop_ClusterAlloc_sane node inst = |
748 | 767 |
forAll (choose (5, 20)) $ \count -> |
749 | 768 |
not (Node.offline node) |
... | ... | |
768 | 787 |
|
769 | 788 |
-- | Checks that on a 2-5 node cluster, we can allocate a random |
770 | 789 |
-- instance spec via tiered allocation (whatever the original instance |
771 |
-- spec), on either one or two nodes |
|
790 |
-- spec), on either one or two nodes.
|
|
772 | 791 |
prop_ClusterCanTieredAlloc node inst = |
773 | 792 |
forAll (choose (2, 5)) $ \count -> |
774 | 793 |
forAll (choose (1, 2)) $ \rqnodes -> |
... | ... | |
787 | 806 |
length ixes == length cstats |
788 | 807 |
|
789 | 808 |
-- | Checks that on a 4-8 node cluster, once we allocate an instance, |
790 |
-- we can also evacuate it |
|
809 |
-- we can also evacuate it.
|
|
791 | 810 |
prop_ClusterAllocEvac node inst = |
792 | 811 |
forAll (choose (4, 8)) $ \count -> |
793 | 812 |
not (Node.offline node) |
... | ... | |
812 | 831 |
_ -> False |
813 | 832 |
|
814 | 833 |
-- | Check that allocating multiple instances on a cluster, then |
815 |
-- adding an empty node, results in a valid rebalance |
|
834 |
-- adding an empty node, results in a valid rebalance.
|
|
816 | 835 |
prop_ClusterAllocBalance = |
817 | 836 |
forAll (genNode (Just 5) (Just 128)) $ \node -> |
818 | 837 |
forAll (choose (3, 5)) $ \count -> |
... | ... | |
831 | 850 |
tbl = Cluster.Table ynl il' cv [] |
832 | 851 |
in canBalance tbl True True False |
833 | 852 |
|
834 |
-- | Checks consistency |
|
853 |
-- | Checks consistency.
|
|
835 | 854 |
prop_ClusterCheckConsistency node inst = |
836 | 855 |
let nl = makeSmallCluster node 3 |
837 | 856 |
[node1, node2, node3] = Container.elems nl |
... | ... | |
845 | 864 |
null (ccheck [(0, inst2)]) && |
846 | 865 |
(not . null $ ccheck [(0, inst3)]) |
847 | 866 |
|
848 |
-- For now, we only test that we don't lose instances during the split
|
|
867 |
-- | For now, we only test that we don't lose instances during the split.
|
|
849 | 868 |
prop_ClusterSplitCluster node inst = |
850 | 869 |
forAll (choose (0, 100)) $ \icnt -> |
851 | 870 |
let nl = makeSmallCluster node 2 |
... | ... | |
867 | 886 |
, run prop_ClusterSplitCluster |
868 | 887 |
] |
869 | 888 |
|
870 |
-- | Check that opcode serialization is idempotent
|
|
889 |
-- ** OpCodes tests
|
|
871 | 890 |
|
891 |
-- | Check that opcode serialization is idempotent. |
|
872 | 892 |
prop_OpCodes_serialization op = |
873 | 893 |
case J.readJSON (J.showJSON op) of |
874 | 894 |
J.Error _ -> False |
... | ... | |
879 | 899 |
[ run prop_OpCodes_serialization |
880 | 900 |
] |
881 | 901 |
|
882 |
-- | Check that (queued) job\/opcode status serialization is idempotent |
|
902 |
-- ** Jobs tests |
|
903 |
|
|
904 |
-- | Check that (queued) job\/opcode status serialization is idempotent. |
|
883 | 905 |
prop_OpStatus_serialization os = |
884 | 906 |
case J.readJSON (J.showJSON os) of |
885 | 907 |
J.Error _ -> False |
... | ... | |
897 | 919 |
, run prop_JobStatus_serialization |
898 | 920 |
] |
899 | 921 |
|
900 |
-- | Loader tests
|
|
922 |
-- ** Loader tests
|
|
901 | 923 |
|
902 | 924 |
prop_Loader_lookupNode ktn inst node = |
903 | 925 |
Loader.lookupNode nl inst node == Data.Map.lookup node nl |
... | ... | |
915 | 937 |
else True) |
916 | 938 |
where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes) |
917 | 939 |
|
918 |
|
|
919 | 940 |
-- | Checks that the number of primary instances recorded on the nodes |
920 |
-- is zero |
|
941 |
-- is zero.
|
|
921 | 942 |
prop_Loader_mergeData ns = |
922 | 943 |
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns |
923 | 944 |
in case Loader.mergeData [] [] [] [] |
Also available in: Unified diff