1060 |
1060 |
IntMap.size il' == length ixes &&
|
1061 |
1061 |
length ixes == length cstats
|
1062 |
1062 |
|
1063 |
|
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
|
1064 |
|
-- we can also evacuate it.
|
1065 |
|
prop_ClusterAllocEvac inst =
|
1066 |
|
forAll (choose (4, 8)) $ \count ->
|
1067 |
|
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
|
1068 |
|
let (nl, il, inst') = makeSmallEmptyCluster node count inst
|
|
1063 |
-- | Helper function to create a cluster with the given range of nodes
|
|
1064 |
-- and allocate an instance on it.
|
|
1065 |
genClusterAlloc count node inst =
|
|
1066 |
let nl = makeSmallCluster node count
|
1069 |
1067 |
in case Cluster.genAllocNodes defGroupList nl 2 True >>=
|
1070 |
|
Cluster.tryAlloc nl il inst' of
|
1071 |
|
Types.Bad _ -> False
|
|
1068 |
Cluster.tryAlloc nl Container.empty inst of
|
|
1069 |
Types.Bad _ -> Types.Bad "Can't allocate"
|
1072 |
1070 |
Types.Ok as ->
|
1073 |
1071 |
case Cluster.asSolution as of
|
1074 |
|
Nothing -> False
|
|
1072 |
Nothing -> Types.Bad "Empty solution?"
|
1075 |
1073 |
Just (xnl, xi, _, _) ->
|
1076 |
|
let sdx = Instance.sNode xi
|
1077 |
|
il' = Container.add (Instance.idx xi) xi il
|
1078 |
|
in case IAlloc.processRelocate defGroupList xnl il'
|
1079 |
|
(Instance.idx xi) 1 [sdx] of
|
1080 |
|
Types.Ok _ -> True
|
1081 |
|
_ -> False
|
|
1074 |
let xil = Container.add (Instance.idx xi) xi Container.empty
|
|
1075 |
in Types.Ok (xnl, xil, xi)
|
|
1076 |
|
|
1077 |
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
|
|
1078 |
-- we can also relocate it.
|
|
1079 |
prop_ClusterAllocRelocate =
|
|
1080 |
forAll (choose (4, 8)) $ \count ->
|
|
1081 |
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
|
|
1082 |
forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
|
|
1083 |
case genClusterAlloc count node inst of
|
|
1084 |
Types.Bad msg -> failTest msg
|
|
1085 |
Types.Ok (nl, il, inst') ->
|
|
1086 |
case IAlloc.processRelocate defGroupList nl il
|
|
1087 |
(Instance.idx inst) 1 [Instance.sNode inst'] of
|
|
1088 |
Types.Ok _ -> printTestCase "??" True -- huh, how to make
|
|
1089 |
-- this nicer...
|
|
1090 |
Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
|
|
1091 |
|
|
1092 |
-- | Helper property checker for the result of a nodeEvac or
|
|
1093 |
-- changeGroup operation.
|
|
1094 |
check_EvacMode grp inst result =
|
|
1095 |
case result of
|
|
1096 |
Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
|
|
1097 |
Types.Ok (_, _, es) ->
|
|
1098 |
let moved = Cluster.esMoved es
|
|
1099 |
failed = Cluster.esFailed es
|
|
1100 |
opcodes = not . null $ Cluster.esOpCodes es
|
|
1101 |
in failmsg ("'failed' not empty: " ++ show failed) (null failed) .&&.
|
|
1102 |
failmsg "'opcodes' is null" opcodes .&&.
|
|
1103 |
case moved of
|
|
1104 |
[(idx', gdx, _)] -> failmsg "invalid instance moved" (idx == idx')
|
|
1105 |
.&&.
|
|
1106 |
failmsg "wrong target group"
|
|
1107 |
(gdx == Group.idx grp)
|
|
1108 |
v -> failmsg ("invalid solution: " ++ show v) False
|
|
1109 |
where failmsg = \msg -> printTestCase ("Failed to evacuate: " ++ msg)
|
|
1110 |
idx = Instance.idx inst
|
|
1111 |
|
|
1112 |
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
|
|
1113 |
-- we can also node-evacuate it.
|
|
1114 |
prop_ClusterAllocEvacuate =
|
|
1115 |
forAll (choose (4, 8)) $ \count ->
|
|
1116 |
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
|
|
1117 |
forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
|
|
1118 |
case genClusterAlloc count node inst of
|
|
1119 |
Types.Bad msg -> failTest msg
|
|
1120 |
Types.Ok (nl, il, inst') ->
|
|
1121 |
conjoin $ map (\mode -> check_EvacMode defGroup inst' $
|
|
1122 |
Cluster.tryNodeEvac defGroupList nl il mode
|
|
1123 |
[Instance.idx inst']) [minBound..maxBound]
|
|
1124 |
|
|
1125 |
-- | Checks that on a 4-8 node cluster with two node groups, once we
|
|
1126 |
-- allocate an instance on the first node group, we can also change
|
|
1127 |
-- its group.
|
|
1128 |
prop_ClusterAllocChangeGroup =
|
|
1129 |
forAll (choose (4, 8)) $ \count ->
|
|
1130 |
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
|
|
1131 |
forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
|
|
1132 |
case genClusterAlloc count node inst of
|
|
1133 |
Types.Bad msg -> failTest msg
|
|
1134 |
Types.Ok (nl, il, inst') ->
|
|
1135 |
-- we need to add a second node group and nodes to the cluster
|
|
1136 |
let nl2 = Container.elems $ makeSmallCluster node count
|
|
1137 |
grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
|
|
1138 |
maxndx = maximum . map Node.idx $ nl2
|
|
1139 |
nl3 = map (\n -> n { Node.group = Group.idx grp2
|
|
1140 |
, Node.idx = Node.idx n + maxndx }) nl2
|
|
1141 |
nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3
|
|
1142 |
gl' = Container.add (Group.idx grp2) grp2 defGroupList
|
|
1143 |
nl' = IntMap.union nl nl4
|
|
1144 |
in check_EvacMode grp2 inst' $
|
|
1145 |
Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst']
|
1082 |
1146 |
|
1083 |
1147 |
-- | Check that allocating multiple instances on a cluster, then
|
1084 |
1148 |
-- adding an empty node, results in a valid rebalance.
|
... | ... | |
1161 |
1225 |
, 'prop_CStats_sane
|
1162 |
1226 |
, 'prop_ClusterAlloc_sane
|
1163 |
1227 |
, 'prop_ClusterCanTieredAlloc
|
1164 |
|
, 'prop_ClusterAllocEvac
|
|
1228 |
, 'prop_ClusterAllocRelocate
|
|
1229 |
, 'prop_ClusterAllocEvacuate
|
|
1230 |
, 'prop_ClusterAllocChangeGroup
|
1165 |
1231 |
, 'prop_ClusterAllocBalance
|
1166 |
1232 |
, 'prop_ClusterCheckConsistency
|
1167 |
1233 |
, 'prop_ClusterSplitCluster
|