Revision 5cefb2b2
| 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