Revision 5cefb2b2 htools/Ganeti/HTools/QC.hs
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
48 | 48 |
import qualified Data.Set as Set |
49 | 49 |
import Data.Maybe |
50 | 50 |
import Control.Monad |
51 |
import Control.Applicative |
|
51 | 52 |
import qualified System.Console.GetOpt as GetOpt |
52 | 53 |
import qualified Text.JSON as J |
53 | 54 |
import qualified Data.Map |
... | ... | |
106 | 107 |
maxSpindleRatio :: Double |
107 | 108 |
maxSpindleRatio = 1024.0 |
108 | 109 |
|
110 |
-- | Max nodes, used just to limit arbitrary instances for smaller |
|
111 |
-- opcode definitions (e.g. list of nodes in OpTestDelay). |
|
112 |
maxNodes :: Int |
|
113 |
maxNodes = 32 |
|
114 |
|
|
115 |
-- | Max opcodes or jobs in a submit job and submit many jobs. |
|
116 |
maxOpCodes :: Int |
|
117 |
maxOpCodes = 16 |
|
118 |
|
|
109 | 119 |
-- | All disk templates (used later) |
110 | 120 |
allDiskTemplates :: [Types.DiskTemplate] |
111 | 121 |
allDiskTemplates = [minBound..maxBound] |
... | ... | |
260 | 270 |
getName :: Gen String |
261 | 271 |
getName = do |
262 | 272 |
n <- choose (1, 64) |
263 |
dn <- vector n::Gen [DNSChar]
|
|
273 |
dn <- vector n |
|
264 | 274 |
return (map dnsGetChar dn) |
265 | 275 |
|
266 | 276 |
-- | Generates an entire FQDN. |
267 | 277 |
getFQDN :: Gen String |
268 | 278 |
getFQDN = do |
269 | 279 |
ncomps <- choose (1, 4) |
270 |
names <- mapM (const getName) [1..ncomps::Int]
|
|
280 |
names <- vectorOf ncomps getName
|
|
271 | 281 |
return $ intercalate "." names |
272 | 282 |
|
283 |
-- | Combinator that generates a 'Maybe' using a sub-combinator. |
|
284 |
getMaybe :: Gen a -> Gen (Maybe a) |
|
285 |
getMaybe subgen = do |
|
286 |
bool <- arbitrary |
|
287 |
if bool |
|
288 |
then Just <$> subgen |
|
289 |
else return Nothing |
|
290 |
|
|
291 |
-- | Generates a fields list. This uses the same character set as a |
|
292 |
-- DNS name (just for simplicity). |
|
293 |
getFields :: Gen [String] |
|
294 |
getFields = do |
|
295 |
n <- choose (1, 32) |
|
296 |
vectorOf n getName |
|
297 |
|
|
273 | 298 |
-- | Defines a tag type. |
274 | 299 |
newtype TagChar = TagChar { tagGetChar :: Char } |
275 | 300 |
|
... | ... | |
386 | 411 |
] |
387 | 412 |
case op_id of |
388 | 413 |
"OP_TEST_DELAY" -> |
389 |
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary |
|
414 |
OpCodes.OpTestDelay <$> arbitrary <*> arbitrary |
|
415 |
<*> resize maxNodes (listOf getFQDN) |
|
390 | 416 |
"OP_INSTANCE_REPLACE_DISKS" -> |
391 |
liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
|
|
392 |
arbitrary arbitrary arbitrary
|
|
417 |
OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> getMaybe getFQDN <*>
|
|
418 |
arbitrary <*> resize C.maxDisks arbitrary <*> getMaybe getName
|
|
393 | 419 |
"OP_INSTANCE_FAILOVER" -> |
394 |
liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
|
|
395 |
arbitrary
|
|
420 |
OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*>
|
|
421 |
getMaybe getFQDN
|
|
396 | 422 |
"OP_INSTANCE_MIGRATE" -> |
397 |
liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
|
|
398 |
arbitrary arbitrary arbitrary
|
|
423 |
OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*>
|
|
424 |
arbitrary <*> arbitrary <*> getMaybe getFQDN
|
|
399 | 425 |
_ -> fail "Wrong opcode" |
400 | 426 |
|
401 | 427 |
instance Arbitrary Jobs.OpStatus where |
... | ... | |
425 | 451 |
instance Arbitrary a => Arbitrary (Types.OpResult a) where |
426 | 452 |
arbitrary = arbitrary >>= \c -> |
427 | 453 |
if c |
428 |
then liftM Types.OpGood arbitrary
|
|
429 |
else liftM Types.OpFail arbitrary
|
|
454 |
then Types.OpGood <$> arbitrary
|
|
455 |
else Types.OpFail <$> arbitrary
|
|
430 | 456 |
|
431 | 457 |
instance Arbitrary Types.ISpec where |
432 | 458 |
arbitrary = do |
Also available in: Unified diff