Revision c66f09f5 htest/Test/Ganeti/OpCodes.hs
| b/htest/Test/Ganeti/OpCodes.hs | ||
|---|---|---|
| 36 | 36 |
|
| 37 | 37 |
import Control.Applicative |
| 38 | 38 |
import Data.List |
| 39 |
import qualified Data.Map as Map |
|
| 39 | 40 |
import qualified Text.JSON as J |
| 40 | 41 |
|
| 41 | 42 |
import Test.Ganeti.TestHelper |
| 42 | 43 |
import Test.Ganeti.TestCommon |
| 43 | 44 |
import Test.Ganeti.Types () |
| 45 |
import Test.Ganeti.Query.Language |
|
| 44 | 46 |
|
| 45 | 47 |
import qualified Ganeti.Constants as C |
| 46 | 48 |
import qualified Ganeti.OpCodes as OpCodes |
| 47 | 49 |
import Ganeti.Types |
| 48 | 50 |
import Ganeti.OpParams |
| 51 |
import Ganeti.JSON |
|
| 49 | 52 |
|
| 50 | 53 |
{-# ANN module "HLint: ignore Use camelCase" #-}
|
| 51 | 54 |
|
| ... | ... | |
| 63 | 66 |
instance Arbitrary OpCodes.DiskIndex where |
| 64 | 67 |
arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex |
| 65 | 68 |
|
| 69 |
$(genArbitrary ''INicParams) |
|
| 70 |
|
|
| 66 | 71 |
instance Arbitrary OpCodes.OpCode where |
| 67 | 72 |
arbitrary = do |
| 68 | 73 |
op_id <- elements OpCodes.allOpIDs |
| ... | ... | |
| 83 | 88 |
OpCodes.OpTagsSet <$> arbitrary <*> genTags |
| 84 | 89 |
"OP_TAGS_DEL" -> |
| 85 | 90 |
OpCodes.OpTagsSet <$> arbitrary <*> genTags |
| 86 |
_ -> fail "Wrong opcode" |
|
| 91 |
"OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit |
|
| 92 |
"OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy |
|
| 93 |
"OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery |
|
| 94 |
"OP_CLUSTER_VERIFY" -> |
|
| 95 |
OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*> |
|
| 96 |
genSet Nothing <*> genSet Nothing <*> arbitrary <*> arbitrary |
|
| 97 |
"OP_CLUSTER_VERIFY_CONFIG" -> |
|
| 98 |
OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*> |
|
| 99 |
genSet Nothing <*> arbitrary |
|
| 100 |
"OP_CLUSTER_VERIFY_GROUP" -> |
|
| 101 |
OpCodes.OpClusterVerifyGroup <$> arbitrary <*> arbitrary <*> |
|
| 102 |
arbitrary <*> genSet Nothing <*> genSet Nothing <*> arbitrary |
|
| 103 |
"OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks |
|
| 104 |
"OP_GROUP_VERIFY_DISKS" -> |
|
| 105 |
OpCodes.OpGroupVerifyDisks <$> arbitrary |
|
| 106 |
"OP_CLUSTER_REPAIR_DISK_SIZES" -> |
|
| 107 |
OpCodes.OpClusterRepairDiskSizes <$> |
|
| 108 |
resize maxNodes (listOf (getFQDN >>= mkNonEmpty)) |
|
| 109 |
"OP_CLUSTER_CONFIG_QUERY" -> |
|
| 110 |
OpCodes.OpClusterConfigQuery <$> resize maxNodes arbitrary |
|
| 111 |
"OP_CLUSTER_RENAME" -> |
|
| 112 |
OpCodes.OpClusterRename <$> (getName >>= mkNonEmpty) |
|
| 113 |
"OP_CLUSTER_SET_PARAMS" -> |
|
| 114 |
OpCodes.OpClusterSetParams <$> emptyMUD <*> emptyMUD <*> |
|
| 115 |
arbitrary <*> getMaybe (listOf1 arbitrary >>= mkNonEmpty) <*> |
|
| 116 |
getMaybe genEmptyContainer <*> emptyMUD <*> |
|
| 117 |
getMaybe genEmptyContainer <*> getMaybe genEmptyContainer <*> |
|
| 118 |
getMaybe genEmptyContainer <*> getMaybe arbitrary <*> |
|
| 119 |
arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 120 |
arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 121 |
emptyMUD <*> emptyMUD <*> arbitrary <*> |
|
| 122 |
arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 123 |
arbitrary <*> arbitrary <*> arbitrary |
|
| 124 |
"OP_CLUSTER_REDIST_CONF" -> pure OpCodes.OpClusterRedistConf |
|
| 125 |
"OP_CLUSTER_ACTIVATE_MASTER_IP" -> |
|
| 126 |
pure OpCodes.OpClusterActivateMasterIp |
|
| 127 |
"OP_CLUSTER_DEACTIVATE_MASTER_IP" -> |
|
| 128 |
pure OpCodes.OpClusterDeactivateMasterIp |
|
| 129 |
"OP_QUERY" -> |
|
| 130 |
OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*> genFilter |
|
| 131 |
"OP_QUERY_FIELDS" -> |
|
| 132 |
OpCodes.OpQueryFields <$> arbitrary <*> arbitrary |
|
| 133 |
"OP_OOB_COMMAND" -> |
|
| 134 |
OpCodes.OpOobCommand <$> genNodeNamesNE <*> arbitrary <*> |
|
| 135 |
arbitrary <*> arbitrary <*> (arbitrary `suchThat` (>0)) |
|
| 136 |
"OP_NODE_REMOVE" -> OpCodes.OpNodeRemove <$> (getFQDN >>= mkNonEmpty) |
|
| 137 |
"OP_NODE_ADD" -> |
|
| 138 |
OpCodes.OpNodeAdd <$> (getFQDN >>= mkNonEmpty) <*> |
|
| 139 |
emptyMUD <*> emptyMUD <*> |
|
| 140 |
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 141 |
arbitrary <*> arbitrary <*> emptyMUD |
|
| 142 |
"OP_NODE_QUERY" -> |
|
| 143 |
OpCodes.OpNodeQuery <$> arbitrary <*> arbitrary <*> arbitrary |
|
| 144 |
"OP_NODE_QUERYVOLS" -> |
|
| 145 |
OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE |
|
| 146 |
"OP_NODE_QUERY_STORAGE" -> |
|
| 147 |
OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*> |
|
| 148 |
genNodeNamesNE <*> arbitrary |
|
| 149 |
"OP_NODE_MODIFY_STORAGE" -> |
|
| 150 |
OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> arbitrary <*> |
|
| 151 |
arbitrary <*> pure emptyJSObject |
|
| 152 |
"OP_REPAIR_NODE_STORAGE" -> |
|
| 153 |
OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> arbitrary <*> |
|
| 154 |
arbitrary <*> arbitrary |
|
| 155 |
"OP_NODE_SET_PARAMS" -> |
|
| 156 |
OpCodes.OpNodeSetParams <$> genNodeNameNE <*> arbitrary <*> |
|
| 157 |
emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 158 |
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 159 |
emptyMUD |
|
| 160 |
"OP_NODE_POWERCYCLE" -> |
|
| 161 |
OpCodes.OpNodePowercycle <$> genNodeNameNE <*> arbitrary |
|
| 162 |
"OP_NODE_MIGRATE" -> |
|
| 163 |
OpCodes.OpNodeMigrate <$> genNodeNameNE <*> arbitrary <*> |
|
| 164 |
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> |
|
| 165 |
arbitrary |
|
| 166 |
"OP_NODE_EVACUATE" -> |
|
| 167 |
OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*> |
|
| 168 |
getMaybe genNodeNameNE <*> arbitrary <*> arbitrary |
|
| 169 |
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id |
|
| 87 | 170 |
|
| 88 | 171 |
-- * Helper functions |
| 89 | 172 |
|
| 173 |
-- | Empty JSObject. |
|
| 174 |
emptyJSObject :: J.JSObject J.JSValue |
|
| 175 |
emptyJSObject = J.toJSObject [] |
|
| 176 |
|
|
| 177 |
-- | Empty maybe unchecked dictionary. |
|
| 178 |
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue)) |
|
| 179 |
emptyMUD = getMaybe $ pure emptyJSObject |
|
| 180 |
|
|
| 181 |
-- | Generates an empty container. |
|
| 182 |
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b) |
|
| 183 |
genEmptyContainer = pure . GenericContainer $ Map.fromList [] |
|
| 184 |
|
|
| 90 | 185 |
-- | Generates list of disk indices. |
| 91 | 186 |
genDiskIndices :: Gen [DiskIndex] |
| 92 | 187 |
genDiskIndices = do |
| ... | ... | |
| 97 | 192 |
genNodeNames :: Gen [String] |
| 98 | 193 |
genNodeNames = resize maxNodes (listOf getFQDN) |
| 99 | 194 |
|
| 195 |
-- | Generates a list of node names in non-empty string type. |
|
| 196 |
genNodeNamesNE :: Gen [NonEmptyString] |
|
| 197 |
genNodeNamesNE = genNodeNames >>= mapM (mkNonEmpty) |
|
| 198 |
|
|
| 100 | 199 |
-- | Gets a node name in non-empty type. |
| 101 | 200 |
genNodeNameNE :: Gen NonEmptyString |
| 102 | 201 |
genNodeNameNE = getFQDN >>= mkNonEmpty |
Also available in: Unified diff