Revision 8d239fa4
b/htest/Test/Ganeti/OpCodes.hs | ||
---|---|---|
38 | 38 |
import Data.List |
39 | 39 |
import qualified Data.Map as Map |
40 | 40 |
import qualified Text.JSON as J |
41 |
import Text.Printf (printf) |
|
41 | 42 |
|
42 | 43 |
import Test.Ganeti.TestHelper |
43 | 44 |
import Test.Ganeti.TestCommon |
... | ... | |
308 | 309 |
"OP_TEST_DUMMY" -> |
309 | 310 |
OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*> |
310 | 311 |
pure J.JSNull <*> pure J.JSNull |
312 |
"OP_NETWORK_ADD" -> |
|
313 |
OpCodes.OpNetworkAdd <$> genNameNE <*> arbitrary <*> genIp4Net <*> |
|
314 |
getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*> |
|
315 |
getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*> |
|
316 |
(genTags >>= mapM mkNonEmpty) |
|
317 |
"OP_NETWORK_REMOVE" -> |
|
318 |
OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary |
|
319 |
"OP_NETWORK_SET_PARAMS" -> |
|
320 |
OpCodes.OpNetworkSetParams <$> genNameNE <*> arbitrary <*> |
|
321 |
getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*> |
|
322 |
getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*> |
|
323 |
getMaybe (listOf genIp4Addr) |
|
324 |
"OP_NETWORK_CONNECT" -> |
|
325 |
OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*> |
|
326 |
arbitrary <*> genNameNE <*> arbitrary |
|
327 |
"OP_NETWORK_DISCONNECT" -> |
|
328 |
OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE <*> arbitrary |
|
329 |
"OP_NETWORK_QUERY" -> |
|
330 |
OpCodes.OpNetworkQuery <$> genFieldsNE <*> genNamesNE |
|
311 | 331 |
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id |
312 | 332 |
|
313 | 333 |
-- * Helper functions |
... | ... | |
354 | 374 |
genFieldsNE :: Gen [NonEmptyString] |
355 | 375 |
genFieldsNE = getFields >>= mapM mkNonEmpty |
356 | 376 |
|
377 |
-- | Generate an arbitrary IPv4 address in textual form. |
|
378 |
genIp4Addr :: Gen NonEmptyString |
|
379 |
genIp4Addr = do |
|
380 |
a <- choose (1::Int, 255) |
|
381 |
b <- choose (0::Int, 255) |
|
382 |
c <- choose (0::Int, 255) |
|
383 |
d <- choose (0::Int, 255) |
|
384 |
mkNonEmpty $ intercalate "." (map show [a, b, c, d]) |
|
385 |
|
|
386 |
-- | Generate an arbitrary IPv4 network address in textual form. |
|
387 |
genIp4Net :: Gen NonEmptyString |
|
388 |
genIp4Net = do |
|
389 |
netmask <- choose (8::Int, 30) |
|
390 |
ip <- genIp4Addr |
|
391 |
mkNonEmpty $ fromNonEmpty ip ++ "/" ++ show netmask |
|
392 |
|
|
393 |
-- | Generate a 3-byte MAC prefix. |
|
394 |
genMacPrefix :: Gen NonEmptyString |
|
395 |
genMacPrefix = do |
|
396 |
octets <- vectorOf 3 $ choose (0::Int, 255) |
|
397 |
mkNonEmpty . intercalate ":" $ map (printf "%02x") octets |
|
398 |
|
|
357 | 399 |
-- * Test cases |
358 | 400 |
|
359 | 401 |
-- | Check that opcode serialization is idempotent. |
b/htest/Test/Ganeti/Types.hs | ||
---|---|---|
103 | 103 |
|
104 | 104 |
$(genArbitrary ''IAllocatorMode) |
105 | 105 |
|
106 |
$(genArbitrary ''NetworkType) |
|
107 |
|
|
106 | 108 |
$(genArbitrary ''NICMode) |
107 | 109 |
|
108 | 110 |
-- * Properties |
... | ... | |
233 | 235 |
all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound] |
234 | 236 |
assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes |
235 | 237 |
|
238 |
-- | Test 'NetworkType' serialisation. |
|
239 |
prop_NetworkType_serialisation :: NetworkType -> Property |
|
240 |
prop_NetworkType_serialisation = testSerialisation |
|
241 |
|
|
242 |
-- | Tests equivalence with Python, based on Constants.hs code. |
|
243 |
case_NetworkType_pyequiv :: Assertion |
|
244 |
case_NetworkType_pyequiv = do |
|
245 |
let all_py_codes = sort C.networkValidTypes |
|
246 |
all_hs_codes = sort $ map Types.networkTypeToRaw [minBound..maxBound] |
|
247 |
assertEqual "for NetworkType equivalence" all_py_codes all_hs_codes |
|
248 |
|
|
236 | 249 |
-- | Test 'NICMode' serialisation. |
237 | 250 |
prop_NICMode_serialisation :: NICMode -> Property |
238 | 251 |
prop_NICMode_serialisation = testSerialisation |
... | ... | |
271 | 284 |
, 'prop_IAllocatorTestDir_serialisation |
272 | 285 |
, 'prop_IAllocatorMode_serialisation |
273 | 286 |
, 'case_IAllocatorMode_pyequiv |
287 |
, 'prop_NetworkType_serialisation |
|
288 |
, 'case_NetworkType_pyequiv |
|
274 | 289 |
, 'prop_NICMode_serialisation |
275 | 290 |
, 'case_NICMode_pyequiv |
276 | 291 |
] |
b/htools/Ganeti/OpCodes.hs | ||
---|---|---|
476 | 476 |
, pTestDummyFail |
477 | 477 |
, pTestDummySubmitJobs |
478 | 478 |
]) |
479 |
, ("OpNetworkAdd", |
|
480 |
[ pNetworkName |
|
481 |
, pNetworkType |
|
482 |
, pNetworkAddress4 |
|
483 |
, pNetworkGateway4 |
|
484 |
, pNetworkAddress6 |
|
485 |
, pNetworkGateway6 |
|
486 |
, pNetworkMacPrefix |
|
487 |
, pNetworkAddRsvdIps |
|
488 |
, pInstTags |
|
489 |
]) |
|
490 |
, ("OpNetworkRemove", |
|
491 |
[ pNetworkName |
|
492 |
, pForce |
|
493 |
]) |
|
494 |
, ("OpNetworkSetParams", |
|
495 |
[ pNetworkName |
|
496 |
, pNetworkType |
|
497 |
, pNetworkGateway4 |
|
498 |
, pNetworkAddress6 |
|
499 |
, pNetworkGateway6 |
|
500 |
, pNetworkMacPrefix |
|
501 |
, pNetworkAddRsvdIps |
|
502 |
, pNetworkRemoveRsvdIps |
|
503 |
]) |
|
504 |
, ("OpNetworkConnect", |
|
505 |
[ pGroupName |
|
506 |
, pNetworkName |
|
507 |
, pNetworkMode |
|
508 |
, pNetworkLink |
|
509 |
, pIpConflictsCheck |
|
510 |
]) |
|
511 |
, ("OpNetworkDisconnect", |
|
512 |
[ pGroupName |
|
513 |
, pNetworkName |
|
514 |
, pIpConflictsCheck |
|
515 |
]) |
|
516 |
, ("OpNetworkQuery", |
|
517 |
[ pOutputFields |
|
518 |
, pNames |
|
519 |
]) |
|
479 | 520 |
]) |
480 | 521 |
|
481 | 522 |
-- | Returns the OP_ID for a given opcode value. |
b/htools/Ganeti/OpParams.hs | ||
---|---|---|
209 | 209 |
, pTestDummyMessages |
210 | 210 |
, pTestDummyFail |
211 | 211 |
, pTestDummySubmitJobs |
212 |
, pNetworkName |
|
213 |
, pNetworkType |
|
214 |
, pNetworkAddress4 |
|
215 |
, pNetworkGateway4 |
|
216 |
, pNetworkAddress6 |
|
217 |
, pNetworkGateway6 |
|
218 |
, pNetworkMacPrefix |
|
219 |
, pNetworkAddRsvdIps |
|
220 |
, pNetworkRemoveRsvdIps |
|
221 |
, pNetworkMode |
|
222 |
, pNetworkLink |
|
212 | 223 |
) where |
213 | 224 |
|
214 | 225 |
import Control.Monad (liftM) |
... | ... | |
1262 | 1273 |
pTestDummySubmitJobs = |
1263 | 1274 |
renameField "TestDummySubmitJobs" $ |
1264 | 1275 |
simpleField "submit_jobs" [t| UncheckedValue |] |
1276 |
|
|
1277 |
-- * Network parameters |
|
1278 |
|
|
1279 |
-- | Network name. |
|
1280 |
pNetworkName :: Field |
|
1281 |
pNetworkName = simpleField "network_name" [t| NonEmptyString |] |
|
1282 |
|
|
1283 |
-- | Network type field. |
|
1284 |
pNetworkType :: Field |
|
1285 |
pNetworkType = optionalField $ simpleField "network_type" [t| NetworkType |] |
|
1286 |
|
|
1287 |
-- | Network address (IPv4 subnet). FIXME: no real type for this. |
|
1288 |
pNetworkAddress4 :: Field |
|
1289 |
pNetworkAddress4 = |
|
1290 |
renameField "NetworkAddress4" $ |
|
1291 |
simpleField "network" [t| NonEmptyString |] |
|
1292 |
|
|
1293 |
-- | Network gateway (IPv4 address). FIXME: no real type for this. |
|
1294 |
pNetworkGateway4 :: Field |
|
1295 |
pNetworkGateway4 = |
|
1296 |
renameField "NetworkGateway4" $ |
|
1297 |
optionalNEStringField "gateway" |
|
1298 |
|
|
1299 |
-- | Network address (IPv6 subnet). FIXME: no real type for this. |
|
1300 |
pNetworkAddress6 :: Field |
|
1301 |
pNetworkAddress6 = |
|
1302 |
renameField "NetworkAddress6" $ |
|
1303 |
optionalNEStringField "network6" |
|
1304 |
|
|
1305 |
-- | Network gateway (IPv6 address). FIXME: no real type for this. |
|
1306 |
pNetworkGateway6 :: Field |
|
1307 |
pNetworkGateway6 = |
|
1308 |
renameField "NetworkGateway6" $ |
|
1309 |
optionalNEStringField "gateway6" |
|
1310 |
|
|
1311 |
-- | Network specific mac prefix (that overrides the cluster one). |
|
1312 |
pNetworkMacPrefix :: Field |
|
1313 |
pNetworkMacPrefix = |
|
1314 |
renameField "NetMacPrefix" $ |
|
1315 |
optionalNEStringField "mac_prefix" |
|
1316 |
|
|
1317 |
-- | Network add reserved IPs. |
|
1318 |
pNetworkAddRsvdIps :: Field |
|
1319 |
pNetworkAddRsvdIps = |
|
1320 |
renameField "NetworkAddRsvdIps" . |
|
1321 |
optionalField $ |
|
1322 |
simpleField "add_reserved_ips" [t| [NonEmptyString] |] |
|
1323 |
|
|
1324 |
-- | Network remove reserved IPs. |
|
1325 |
pNetworkRemoveRsvdIps :: Field |
|
1326 |
pNetworkRemoveRsvdIps = |
|
1327 |
renameField "NetworkRemoveRsvdIps" . |
|
1328 |
optionalField $ |
|
1329 |
simpleField "remove_reserved_ips" [t| [NonEmptyString] |] |
|
1330 |
|
|
1331 |
-- | Network mode when connecting to a group. |
|
1332 |
pNetworkMode :: Field |
|
1333 |
pNetworkMode = simpleField "network_mode" [t| NICMode |] |
|
1334 |
|
|
1335 |
-- | Network link when connecting to a group. |
|
1336 |
pNetworkLink :: Field |
|
1337 |
pNetworkLink = simpleField "network_link" [t| NonEmptyString |] |
b/htools/Ganeti/Types.hs | ||
---|---|---|
67 | 67 |
, IAllocatorTestDir(..) |
68 | 68 |
, IAllocatorMode(..) |
69 | 69 |
, iAllocatorModeToRaw |
70 |
, NetworkType(..) |
|
71 |
, networkTypeToRaw |
|
70 | 72 |
, NICMode(..) |
71 | 73 |
, nICModeToRaw |
72 | 74 |
) where |
... | ... | |
317 | 319 |
]) |
318 | 320 |
$(THH.makeJSONInstance ''IAllocatorMode) |
319 | 321 |
|
322 |
-- | Network type. |
|
323 |
$(THH.declareSADT "NetworkType" |
|
324 |
[ ("PrivateNetwork", 'C.networkTypePrivate) |
|
325 |
, ("PublicNetwork", 'C.networkTypePublic) |
|
326 |
]) |
|
327 |
$(THH.makeJSONInstance ''NetworkType) |
|
328 |
|
|
320 | 329 |
-- | Netork mode. |
321 | 330 |
$(THH.declareSADT "NICMode" |
322 | 331 |
[ ("NMBridged", 'C.nicModeBridged) |
Also available in: Unified diff