Revision c7d249d0
| b/htest/Test/Ganeti/OpCodes.hs | ||
|---|---|---|
| 40 | 40 |
|
| 41 | 41 |
import Test.Ganeti.TestHelper |
| 42 | 42 |
import Test.Ganeti.TestCommon |
| 43 |
import Test.Ganeti.Types () |
|
| 43 | 44 |
|
| 44 | 45 |
import qualified Ganeti.Constants as C |
| 45 | 46 |
import qualified Ganeti.OpCodes as OpCodes |
| 47 |
import Ganeti.Types |
|
| 48 |
import Ganeti.OpParams |
|
| 46 | 49 |
|
| 47 | 50 |
{-# ANN module "HLint: ignore Use camelCase" #-}
|
| 48 | 51 |
|
| ... | ... | |
| 66 | 69 |
case op_id of |
| 67 | 70 |
"OP_TEST_DELAY" -> |
| 68 | 71 |
OpCodes.OpTestDelay <$> arbitrary <*> arbitrary |
| 69 |
<*> resize maxNodes (listOf getFQDN)
|
|
| 72 |
<*> genNodeNames
|
|
| 70 | 73 |
"OP_INSTANCE_REPLACE_DISKS" -> |
| 71 |
OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> getMaybe getFQDN <*>
|
|
| 72 |
arbitrary <*> resize C.maxDisks arbitrary <*> getMaybe getName
|
|
| 74 |
OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> |
|
| 75 |
getMaybe genNodeNameNE <*> arbitrary <*> genDiskIndices <*> arbitrary
|
|
| 73 | 76 |
"OP_INSTANCE_FAILOVER" -> |
| 74 | 77 |
OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*> |
| 75 |
getMaybe getFQDN
|
|
| 78 |
getMaybe genNodeNameNE
|
|
| 76 | 79 |
"OP_INSTANCE_MIGRATE" -> |
| 77 | 80 |
OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*> |
| 78 |
arbitrary <*> arbitrary <*> getMaybe getFQDN
|
|
| 81 |
arbitrary <*> arbitrary <*> getMaybe genNodeNameNE
|
|
| 79 | 82 |
"OP_TAGS_SET" -> |
| 80 | 83 |
OpCodes.OpTagsSet <$> arbitrary <*> genTags |
| 81 | 84 |
"OP_TAGS_DEL" -> |
| 82 | 85 |
OpCodes.OpTagsSet <$> arbitrary <*> genTags |
| 83 | 86 |
_ -> fail "Wrong opcode" |
| 84 | 87 |
|
| 88 |
-- * Helper functions |
|
| 89 |
|
|
| 90 |
-- | Generates list of disk indices. |
|
| 91 |
genDiskIndices :: Gen [DiskIndex] |
|
| 92 |
genDiskIndices = do |
|
| 93 |
cnt <- choose (0, C.maxDisks) |
|
| 94 |
genUniquesList cnt |
|
| 95 |
|
|
| 96 |
-- | Generates a list of node names. |
|
| 97 |
genNodeNames :: Gen [String] |
|
| 98 |
genNodeNames = resize maxNodes (listOf getFQDN) |
|
| 99 |
|
|
| 100 |
-- | Gets a node name in non-empty type. |
|
| 101 |
genNodeNameNE :: Gen NonEmptyString |
|
| 102 |
genNodeNameNE = getFQDN >>= mkNonEmpty |
|
| 103 |
|
|
| 85 | 104 |
-- * Test cases |
| 86 | 105 |
|
| 87 | 106 |
-- | Check that opcode serialization is idempotent. |
| b/htools/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 90 | 90 |
import Ganeti.Compat |
| 91 | 91 |
import qualified Ganeti.OpCodes as OpCodes |
| 92 | 92 |
import Ganeti.Utils |
| 93 |
import Ganeti.Types (mkNonEmpty) |
|
| 93 | 94 |
|
| 94 | 95 |
-- * Types |
| 95 | 96 |
|
| ... | ... | |
| 1447 | 1448 |
iMoveToJob nl il idx move = |
| 1448 | 1449 |
let inst = Container.find idx il |
| 1449 | 1450 |
iname = Instance.name inst |
| 1450 |
lookNode = Just . Container.nameOf nl |
|
| 1451 |
lookNode n = case mkNonEmpty (Container.nameOf nl n) of |
|
| 1452 |
-- FIXME: convert htools codebase to non-empty strings |
|
| 1453 |
Bad msg -> error $ "Empty node name for idx " ++ |
|
| 1454 |
show n ++ ": " ++ msg ++ "??" |
|
| 1455 |
Ok ne -> Just ne |
|
| 1451 | 1456 |
opF = OpCodes.OpInstanceMigrate iname True False True Nothing |
| 1452 | 1457 |
opFA n = OpCodes.OpInstanceMigrate iname True False True (lookNode n) |
| 1453 | 1458 |
opR n = OpCodes.OpInstanceReplaceDisks iname (lookNode n) |
| b/htools/Ganeti/OpCodes.hs | ||
|---|---|---|
| 57 | 57 |
]) |
| 58 | 58 |
, ("OpInstanceReplaceDisks",
|
| 59 | 59 |
[ pInstanceName |
| 60 |
, optionalField $ simpleField "remote_node" [t| String |]
|
|
| 60 |
, pRemoteNode
|
|
| 61 | 61 |
, simpleField "mode" [t| ReplaceDisksMode |] |
| 62 | 62 |
, simpleField "disks" [t| [DiskIndex] |] |
| 63 |
, optionalField $ simpleField "iallocator" [t| String |]
|
|
| 63 |
, pIallocator
|
|
| 64 | 64 |
]) |
| 65 | 65 |
, ("OpInstanceFailover",
|
| 66 | 66 |
[ pInstanceName |
| 67 | 67 |
, simpleField "ignore_consistency" [t| Bool |] |
| 68 |
, optionalField $ simpleField "target_node" [t| String |]
|
|
| 68 |
, pMigrationTargetNode
|
|
| 69 | 69 |
]) |
| 70 | 70 |
, ("OpInstanceMigrate",
|
| 71 | 71 |
[ pInstanceName |
| 72 | 72 |
, simpleField "live" [t| Bool |] |
| 73 | 73 |
, simpleField "cleanup" [t| Bool |] |
| 74 | 74 |
, defaultField [| False |] $ simpleField "allow_failover" [t| Bool |] |
| 75 |
, optionalField $ simpleField "target_node" [t| String |]
|
|
| 75 |
, pMigrationTargetNode
|
|
| 76 | 76 |
]) |
| 77 | 77 |
, ("OpTagsSet",
|
| 78 | 78 |
[ pTagsObject |
Also available in: Unified diff