Revision a3f02317
| b/htest/Test/Ganeti/OpCodes.hs | ||
|---|---|---|
| 294 | 294 |
getMaybe (pure []) <*> getMaybe genNameNE |
| 295 | 295 |
"OP_BACKUP_REMOVE" -> |
| 296 | 296 |
OpCodes.OpBackupRemove <$> getFQDN |
| 297 |
"OP_TEST_ALLOCATOR" -> |
|
| 298 |
OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*> |
|
| 299 |
genNameNE <*> pure [] <*> pure [] <*> |
|
| 300 |
arbitrary <*> getMaybe genNameNE <*> |
|
| 301 |
(genTags >>= mapM mkNonEmpty) <*> |
|
| 302 |
arbitrary <*> arbitrary <*> getMaybe genNameNE <*> |
|
| 303 |
arbitrary <*> getMaybe genNodeNamesNE <*> arbitrary <*> |
|
| 304 |
getMaybe genNamesNE <*> arbitrary <*> arbitrary |
|
| 305 |
"OP_TEST_JQUEUE" -> |
|
| 306 |
OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*> |
|
| 307 |
resize 20 (listOf getFQDN) <*> arbitrary |
|
| 308 |
"OP_TEST_DUMMY" -> |
|
| 309 |
OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*> |
|
| 310 |
pure J.JSNull <*> pure J.JSNull |
|
| 297 | 311 |
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id |
| 298 | 312 |
|
| 299 | 313 |
-- * Helper functions |
| b/htest/Test/Ganeti/Types.hs | ||
|---|---|---|
| 99 | 99 |
|
| 100 | 100 |
$(genArbitrary ''ExportMode) |
| 101 | 101 |
|
| 102 |
$(genArbitrary ''IAllocatorTestDir) |
|
| 103 |
|
|
| 104 |
$(genArbitrary ''IAllocatorMode) |
|
| 105 |
|
|
| 102 | 106 |
-- * Properties |
| 103 | 107 |
|
| 104 | 108 |
prop_AllocPolicy_serialisation :: AllocPolicy -> Property |
| ... | ... | |
| 212 | 216 |
prop_ExportMode_serialisation :: ExportMode -> Property |
| 213 | 217 |
prop_ExportMode_serialisation = testSerialisation |
| 214 | 218 |
|
| 219 |
-- | Test 'IAllocatorTestDir' serialisation. |
|
| 220 |
prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property |
|
| 221 |
prop_IAllocatorTestDir_serialisation = testSerialisation |
|
| 222 |
|
|
| 223 |
-- | Test 'IAllocatorMode' serialisation. |
|
| 224 |
prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property |
|
| 225 |
prop_IAllocatorMode_serialisation = testSerialisation |
|
| 226 |
|
|
| 227 |
-- | Tests equivalence with Python, based on Constants.hs code. |
|
| 228 |
case_IAllocatorMode_pyequiv :: Assertion |
|
| 229 |
case_IAllocatorMode_pyequiv = do |
|
| 230 |
let all_py_codes = sort C.validIallocatorModes |
|
| 231 |
all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound] |
|
| 232 |
assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes |
|
| 233 |
|
|
| 215 | 234 |
testSuite "Types" |
| 216 | 235 |
[ 'prop_AllocPolicy_serialisation |
| 217 | 236 |
, 'prop_DiskTemplate_serialisation |
| ... | ... | |
| 236 | 255 |
, 'prop_InstCreateMode_serialisation |
| 237 | 256 |
, 'prop_RebootType_serialisation |
| 238 | 257 |
, 'prop_ExportMode_serialisation |
| 258 |
, 'prop_IAllocatorTestDir_serialisation |
|
| 259 |
, 'prop_IAllocatorMode_serialisation |
|
| 260 |
, 'case_IAllocatorMode_pyequiv |
|
| 239 | 261 |
] |
| b/htools/Ganeti/OpCodes.hs | ||
|---|---|---|
| 445 | 445 |
]) |
| 446 | 446 |
, ("OpBackupRemove",
|
| 447 | 447 |
[ pInstanceName ]) |
| 448 |
, ("OpTestAllocator",
|
|
| 449 |
[ pIAllocatorDirection |
|
| 450 |
, pIAllocatorMode |
|
| 451 |
, pIAllocatorReqName |
|
| 452 |
, pIAllocatorNics |
|
| 453 |
, pIAllocatorDisks |
|
| 454 |
, pHypervisor |
|
| 455 |
, pIallocator |
|
| 456 |
, pInstTags |
|
| 457 |
, pIAllocatorMemory |
|
| 458 |
, pIAllocatorVCpus |
|
| 459 |
, pIAllocatorOs |
|
| 460 |
, pDiskTemplate |
|
| 461 |
, pIAllocatorInstances |
|
| 462 |
, pIAllocatorEvacMode |
|
| 463 |
, pTargetGroups |
|
| 464 |
, pIAllocatorSpindleUse |
|
| 465 |
, pIAllocatorCount |
|
| 466 |
]) |
|
| 467 |
, ("OpTestJqueue",
|
|
| 468 |
[ pJQueueNotifyWaitLock |
|
| 469 |
, pJQueueNotifyExec |
|
| 470 |
, pJQueueLogMessages |
|
| 471 |
, pJQueueFail |
|
| 472 |
]) |
|
| 473 |
, ("OpTestDummy",
|
|
| 474 |
[ pTestDummyResult |
|
| 475 |
, pTestDummyMessages |
|
| 476 |
, pTestDummyFail |
|
| 477 |
, pTestDummySubmitJobs |
|
| 478 |
]) |
|
| 448 | 479 |
]) |
| 449 | 480 |
|
| 450 | 481 |
-- | Returns the OP_ID for a given opcode value. |
| b/htools/Ganeti/OpParams.hs | ||
|---|---|---|
| 189 | 189 |
, pX509DestCA |
| 190 | 190 |
, pTagSearchPattern |
| 191 | 191 |
, pDelayRepeat |
| 192 |
, pIAllocatorDirection |
|
| 193 |
, pIAllocatorMode |
|
| 194 |
, pIAllocatorReqName |
|
| 195 |
, pIAllocatorNics |
|
| 196 |
, pIAllocatorDisks |
|
| 197 |
, pIAllocatorMemory |
|
| 198 |
, pIAllocatorVCpus |
|
| 199 |
, pIAllocatorOs |
|
| 200 |
, pIAllocatorInstances |
|
| 201 |
, pIAllocatorEvacMode |
|
| 202 |
, pIAllocatorSpindleUse |
|
| 203 |
, pIAllocatorCount |
|
| 204 |
, pJQueueNotifyWaitLock |
|
| 205 |
, pJQueueNotifyExec |
|
| 206 |
, pJQueueLogMessages |
|
| 207 |
, pJQueueFail |
|
| 208 |
, pTestDummyResult |
|
| 209 |
, pTestDummyMessages |
|
| 210 |
, pTestDummyFail |
|
| 211 |
, pTestDummySubmitJobs |
|
| 192 | 212 |
) where |
| 193 | 213 |
|
| 194 | 214 |
import Control.Monad (liftM) |
| ... | ... | |
| 233 | 253 |
optionalNEStringField :: String -> Field |
| 234 | 254 |
optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |] |
| 235 | 255 |
|
| 236 |
--- | Unchecked value, should be replaced by a better definition.
|
|
| 237 |
--- type UncheckedValue = JSValue
|
|
| 256 |
-- | Unchecked value, should be replaced by a better definition. |
|
| 257 |
type UncheckedValue = JSValue |
|
| 238 | 258 |
|
| 239 | 259 |
-- | Unchecked dict, should be replaced by a better definition. |
| 240 | 260 |
type UncheckedDict = JSObject JSValue |
| ... | ... | |
| 1121 | 1141 |
pTagSearchPattern = |
| 1122 | 1142 |
renameField "TagSearchPattern" $ simpleField "pattern" [t| NonEmptyString |] |
| 1123 | 1143 |
|
| 1144 |
-- * Test opcode parameters |
|
| 1145 |
|
|
| 1124 | 1146 |
-- | Repeat parameter for OpTestDelay. |
| 1125 | 1147 |
pDelayRepeat :: Field |
| 1126 | 1148 |
pDelayRepeat = |
| 1127 | 1149 |
renameField "DelayRepeat" . |
| 1128 | 1150 |
defaultField [| forceNonNeg (0::Int) |] $ |
| 1129 | 1151 |
simpleField "repeat" [t| NonNegative Int |] |
| 1152 |
|
|
| 1153 |
-- | IAllocator test direction. |
|
| 1154 |
pIAllocatorDirection :: Field |
|
| 1155 |
pIAllocatorDirection = |
|
| 1156 |
renameField "IAllocatorDirection" $ |
|
| 1157 |
simpleField "direction" [t| IAllocatorTestDir |] |
|
| 1158 |
|
|
| 1159 |
-- | IAllocator test mode. |
|
| 1160 |
pIAllocatorMode :: Field |
|
| 1161 |
pIAllocatorMode = |
|
| 1162 |
renameField "IAllocatorMode" $ |
|
| 1163 |
simpleField "mode" [t| IAllocatorMode |] |
|
| 1164 |
|
|
| 1165 |
-- | IAllocator target name (new instance, node to evac, etc.). |
|
| 1166 |
pIAllocatorReqName :: Field |
|
| 1167 |
pIAllocatorReqName = |
|
| 1168 |
renameField "IAllocatorReqName" $ simpleField "name" [t| NonEmptyString |] |
|
| 1169 |
|
|
| 1170 |
-- | Custom OpTestIAllocator nics. |
|
| 1171 |
pIAllocatorNics :: Field |
|
| 1172 |
pIAllocatorNics = |
|
| 1173 |
renameField "IAllocatorNics" $ simpleField "nics" [t| [UncheckedDict] |] |
|
| 1174 |
|
|
| 1175 |
-- | Custom OpTestAllocator disks. |
|
| 1176 |
pIAllocatorDisks :: Field |
|
| 1177 |
pIAllocatorDisks = |
|
| 1178 |
renameField "IAllocatorDisks" $ simpleField "disks" [t| UncheckedList |] |
|
| 1179 |
|
|
| 1180 |
-- | IAllocator memory field. |
|
| 1181 |
pIAllocatorMemory :: Field |
|
| 1182 |
pIAllocatorMemory = |
|
| 1183 |
renameField "IAllocatorMem" . |
|
| 1184 |
optionalField $ |
|
| 1185 |
simpleField "memory" [t| NonNegative Int |] |
|
| 1186 |
|
|
| 1187 |
-- | IAllocator vcpus field. |
|
| 1188 |
pIAllocatorVCpus :: Field |
|
| 1189 |
pIAllocatorVCpus = |
|
| 1190 |
renameField "IAllocatorVCpus" . |
|
| 1191 |
optionalField $ |
|
| 1192 |
simpleField "vcpus" [t| NonNegative Int |] |
|
| 1193 |
|
|
| 1194 |
-- | IAllocator os field. |
|
| 1195 |
pIAllocatorOs :: Field |
|
| 1196 |
pIAllocatorOs = renameField "IAllocatorOs" $ optionalNEStringField "os" |
|
| 1197 |
|
|
| 1198 |
-- | IAllocator instances field. |
|
| 1199 |
pIAllocatorInstances :: Field |
|
| 1200 |
pIAllocatorInstances = |
|
| 1201 |
renameField "IAllocatorInstances " . |
|
| 1202 |
optionalField $ |
|
| 1203 |
simpleField "instances" [t| [NonEmptyString] |] |
|
| 1204 |
|
|
| 1205 |
-- | IAllocator evac mode. |
|
| 1206 |
pIAllocatorEvacMode :: Field |
|
| 1207 |
pIAllocatorEvacMode = |
|
| 1208 |
renameField "IAllocatorEvacMode" . |
|
| 1209 |
optionalField $ |
|
| 1210 |
simpleField "evac_mode" [t| NodeEvacMode |] |
|
| 1211 |
|
|
| 1212 |
-- | IAllocator spindle use. |
|
| 1213 |
pIAllocatorSpindleUse :: Field |
|
| 1214 |
pIAllocatorSpindleUse = |
|
| 1215 |
renameField "IAllocatorSpindleUse" . |
|
| 1216 |
defaultField [| forceNonNeg (1::Int) |] $ |
|
| 1217 |
simpleField "spindle_use" [t| NonNegative Int |] |
|
| 1218 |
|
|
| 1219 |
-- | IAllocator count field. |
|
| 1220 |
pIAllocatorCount :: Field |
|
| 1221 |
pIAllocatorCount = |
|
| 1222 |
renameField "IAllocatorCount" . |
|
| 1223 |
defaultField [| forceNonNeg (1::Int) |] $ |
|
| 1224 |
simpleField "count" [t| NonNegative Int |] |
|
| 1225 |
|
|
| 1226 |
-- | 'OpTestJqueue' notify_waitlock. |
|
| 1227 |
pJQueueNotifyWaitLock :: Field |
|
| 1228 |
pJQueueNotifyWaitLock = defaultFalse "notify_waitlock" |
|
| 1229 |
|
|
| 1230 |
-- | 'OpTestJQueue' notify_exec. |
|
| 1231 |
pJQueueNotifyExec :: Field |
|
| 1232 |
pJQueueNotifyExec = defaultFalse "notify_exec" |
|
| 1233 |
|
|
| 1234 |
-- | 'OpTestJQueue' log_messages. |
|
| 1235 |
pJQueueLogMessages :: Field |
|
| 1236 |
pJQueueLogMessages = |
|
| 1237 |
defaultField [| [] |] $ simpleField "log_messages" [t| [String] |] |
|
| 1238 |
|
|
| 1239 |
-- | 'OpTestJQueue' fail attribute. |
|
| 1240 |
pJQueueFail :: Field |
|
| 1241 |
pJQueueFail = |
|
| 1242 |
renameField "JQueueFail" $ defaultFalse "fail" |
|
| 1243 |
|
|
| 1244 |
-- | 'OpTestDummy' result field. |
|
| 1245 |
pTestDummyResult :: Field |
|
| 1246 |
pTestDummyResult = |
|
| 1247 |
renameField "TestDummyResult" $ simpleField "result" [t| UncheckedValue |] |
|
| 1248 |
|
|
| 1249 |
-- | 'OpTestDummy' messages field. |
|
| 1250 |
pTestDummyMessages :: Field |
|
| 1251 |
pTestDummyMessages = |
|
| 1252 |
renameField "TestDummyMessages" $ |
|
| 1253 |
simpleField "messages" [t| UncheckedValue |] |
|
| 1254 |
|
|
| 1255 |
-- | 'OpTestDummy' fail field. |
|
| 1256 |
pTestDummyFail :: Field |
|
| 1257 |
pTestDummyFail = |
|
| 1258 |
renameField "TestDummyFail" $ simpleField "fail" [t| UncheckedValue |] |
|
| 1259 |
|
|
| 1260 |
-- | 'OpTestDummy' submit_jobs field. |
|
| 1261 |
pTestDummySubmitJobs :: Field |
|
| 1262 |
pTestDummySubmitJobs = |
|
| 1263 |
renameField "TestDummySubmitJobs" $ |
|
| 1264 |
simpleField "submit_jobs" [t| UncheckedValue |] |
|
| b/htools/Ganeti/Types.hs | ||
|---|---|---|
| 64 | 64 |
, InstCreateMode(..) |
| 65 | 65 |
, RebootType(..) |
| 66 | 66 |
, ExportMode(..) |
| 67 |
, IAllocatorTestDir(..) |
|
| 68 |
, IAllocatorMode(..) |
|
| 69 |
, iAllocatorModeToRaw |
|
| 67 | 70 |
) where |
| 68 | 71 |
|
| 69 | 72 |
import qualified Text.JSON as JSON |
| ... | ... | |
| 294 | 297 |
, ("ExportModeRemove", 'C.exportModeRemote)
|
| 295 | 298 |
]) |
| 296 | 299 |
$(THH.makeJSONInstance ''ExportMode) |
| 300 |
|
|
| 301 |
-- | IAllocator run types (OpTestIAllocator). |
|
| 302 |
$(THH.declareSADT "IAllocatorTestDir" |
|
| 303 |
[ ("IAllocatorDirIn", 'C.iallocatorDirIn)
|
|
| 304 |
, ("IAllocatorDirOut", 'C.iallocatorDirOut)
|
|
| 305 |
]) |
|
| 306 |
$(THH.makeJSONInstance ''IAllocatorTestDir) |
|
| 307 |
|
|
| 308 |
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc". |
|
| 309 |
$(THH.declareSADT "IAllocatorMode" |
|
| 310 |
[ ("IAllocatorAlloc", 'C.iallocatorModeAlloc)
|
|
| 311 |
, ("IAllocatorMultiAlloc", 'C.iallocatorModeMultiAlloc)
|
|
| 312 |
, ("IAllocatorReloc", 'C.iallocatorModeReloc)
|
|
| 313 |
, ("IAllocatorNodeEvac", 'C.iallocatorModeNodeEvac)
|
|
| 314 |
, ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
|
|
| 315 |
]) |
|
| 316 |
$(THH.makeJSONInstance ''IAllocatorMode) |
|
Also available in: Unified diff