, testLoader
, testTypes
, testCLI
+ , testJSON
+ , testLUXI
+ , testSsconf
) where
import Test.QuickCheck
import qualified Data.Set as Set
import Data.Maybe
import Control.Monad
+import Control.Applicative
import qualified System.Console.GetOpt as GetOpt
import qualified Text.JSON as J
import qualified Data.Map
import qualified Ganeti.OpCodes as OpCodes
import qualified Ganeti.Jobs as Jobs
-import qualified Ganeti.Luxi
+import qualified Ganeti.Luxi as Luxi
+import qualified Ganeti.Ssconf as Ssconf
import qualified Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.JSON as JSON
import qualified Ganeti.HTools.Loader as Loader
-import qualified Ganeti.HTools.Luxi
+import qualified Ganeti.HTools.Luxi as HTools.Luxi
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.PeerMap as PeerMap
maxSpindleRatio :: Double
maxSpindleRatio = 1024.0
+-- | Max nodes, used just to limit arbitrary instances for smaller
+-- opcode definitions (e.g. list of nodes in OpTestDelay).
+maxNodes :: Int
+maxNodes = 32
+
+-- | Max opcodes or jobs in a submit job and submit many jobs.
+maxOpCodes :: Int
+maxOpCodes = 16
+
-- | All disk templates (used later)
allDiskTemplates :: [Types.DiskTemplate]
allDiskTemplates = [minBound..maxBound]
-- | Checks if an instance is mirrored.
isMirrored :: Instance.Instance -> Bool
-isMirrored =
- (/= Types.MirrorNone) . Types.templateMirrorType . Instance.diskTemplate
+isMirrored = (/= Types.MirrorNone) . Instance.mirrorType
-- | Returns the possible change node types for a disk template.
evacModeOptions :: Types.MirrorType -> [Types.EvacMode]
getName :: Gen String
getName = do
n <- choose (1, 64)
- dn <- vector n::Gen [DNSChar]
+ dn <- vector n
return (map dnsGetChar dn)
-- | Generates an entire FQDN.
getFQDN :: Gen String
getFQDN = do
ncomps <- choose (1, 4)
- names <- mapM (const getName) [1..ncomps::Int]
+ names <- vectorOf ncomps getName
return $ intercalate "." names
+-- | Combinator that generates a 'Maybe' using a sub-combinator.
+getMaybe :: Gen a -> Gen (Maybe a)
+getMaybe subgen = do
+ bool <- arbitrary
+ if bool
+ then Just <$> subgen
+ else return Nothing
+
+-- | Generates a fields list. This uses the same character set as a
+-- DNS name (just for simplicity).
+getFields :: Gen [String]
+getFields = do
+ n <- choose (1, 32)
+ vectorOf n getName
+
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }
]
case op_id of
"OP_TEST_DELAY" ->
- liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
+ OpCodes.OpTestDelay <$> arbitrary <*> arbitrary
+ <*> resize maxNodes (listOf getFQDN)
"OP_INSTANCE_REPLACE_DISKS" ->
- liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
- arbitrary arbitrary arbitrary
+ OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> getMaybe getFQDN <*>
+ arbitrary <*> resize C.maxDisks arbitrary <*> getMaybe getName
"OP_INSTANCE_FAILOVER" ->
- liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
- arbitrary
+ OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*>
+ getMaybe getFQDN
"OP_INSTANCE_MIGRATE" ->
- liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
- arbitrary arbitrary arbitrary
+ OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*>
+ arbitrary <*> arbitrary <*> getMaybe getFQDN
_ -> fail "Wrong opcode"
instance Arbitrary Jobs.OpStatus where
instance Arbitrary a => Arbitrary (Types.OpResult a) where
arbitrary = arbitrary >>= \c ->
if c
- then liftM Types.OpGood arbitrary
- else liftM Types.OpFail arbitrary
+ then Types.OpGood <$> arbitrary
+ else Types.OpFail <$> arbitrary
instance Arbitrary Types.ISpec where
arbitrary = do
-- | We test that in a cluster, given a random node, we can find it by
-- its name and alias, as long as all names and aliases are unique,
-- and that we fail to find a non-existing name.
-prop_Container_findByName node =
+prop_Container_findByName =
+ forAll (genNode (Just 1) Nothing) $ \node ->
forAll (choose (1, 20)) $ \ cnt ->
forAll (choose (0, cnt - 1)) $ \ fidx ->
forAll (genUniquesList (cnt * 2)) $ \ allnames ->
$ zip names nodes
nl' = Container.fromList nodes'
target = snd (nodes' !! fidx)
- in Container.findByName nl' (Node.name target) == Just target &&
- Container.findByName nl' (Node.alias target) == Just target &&
- isNothing (Container.findByName nl' othername)
+ in Container.findByName nl' (Node.name target) ==? Just target .&&.
+ Container.findByName nl' (Node.alias target) ==? Just target .&&.
+ printTestCase "Found non-existing name"
+ (isNothing (Container.findByName nl' othername))
testSuite "Container"
[ 'prop_Container_addTwo
then Node.noSecondary
else sdx) &&
Instance.autoBalance i == autobal &&
- Instance.spindleUsage i == su &&
+ Instance.spindleUse i == su &&
Types.isBad fail1
prop_Text_Load_InstanceFail ktn fields =
prop_Text_Load_NodeFail fields =
length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
-prop_Text_NodeLSIdempotent node =
- (Text.loadNode defGroupAssoc.
- Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==?
- Just (Node.name n, n)
- -- override failN1 to what loadNode returns by default
- where n = Node.setPolicy Types.defIPolicy $
- node { Node.failN1 = True, Node.offline = False }
+prop_Text_NodeLSIdempotent =
+ forAll (genNode (Just 1) Nothing) $ \node ->
+ -- override failN1 to what loadNode returns by default
+ let n = Node.setPolicy Types.defIPolicy $
+ node { Node.failN1 = True, Node.offline = False }
+ in
+ (Text.loadNode defGroupAssoc.
+ Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==?
+ Just (Node.name n, n)
prop_Text_ISpecIdempotent ispec =
case Text.loadISpec "dummy" . Utils.sepSplit ',' .
conjoin $ map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode
[Instance.idx inst']) .
- evacModeOptions . Types.templateMirrorType .
- Instance.diskTemplate $ inst'
+ evacModeOptions .
+ Instance.mirrorType $ inst'
-- | Checks that on a 4-8 node cluster with two node groups, once we
-- allocate an instance on the first node group, we can also change
, 'prop_CLI_StringArg
, 'prop_CLI_stdopts
]
+
+-- * JSON tests
+
+prop_JSON_toArray :: [Int] -> Property
+prop_JSON_toArray intarr =
+ let arr = map J.showJSON intarr in
+ case JSON.toArray (J.JSArray arr) of
+ Types.Ok arr' -> arr ==? arr'
+ Types.Bad err -> failTest $ "Failed to parse array: " ++ err
+
+prop_JSON_toArrayFail :: Int -> String -> Bool -> Property
+prop_JSON_toArrayFail i s b =
+ -- poor man's instance Arbitrary JSValue
+ forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
+ case JSON.toArray item of
+ Types.Bad _ -> property True
+ Types.Ok result -> failTest $ "Unexpected parse, got " ++ show result
+
+testSuite "JSON"
+ [ 'prop_JSON_toArray
+ , 'prop_JSON_toArrayFail
+ ]
+
+-- * Luxi tests
+
+instance Arbitrary Luxi.LuxiReq where
+ arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Luxi.QrViaLuxi where
+ arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Luxi.LuxiOp where
+ arbitrary = do
+ lreq <- arbitrary
+ case lreq of
+ Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> getFields <*> arbitrary
+ Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> (listOf getFQDN) <*>
+ getFields <*> arbitrary
+ Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*>
+ arbitrary <*> arbitrary
+ Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> (listOf getFQDN) <*>
+ getFields <*> arbitrary
+ Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> getFields
+ Luxi.ReqQueryExports -> Luxi.QueryExports <$>
+ (listOf getFQDN) <*> arbitrary
+ Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields
+ Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo
+ Luxi.ReqQueryTags -> Luxi.QueryTags <$> getName <*> getFQDN
+ Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary)
+ Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>
+ (resize maxOpCodes arbitrary)
+ Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*>
+ getFields <*> pure J.JSNull <*>
+ pure J.JSNull <*> arbitrary
+ Luxi.ReqArchiveJob -> Luxi.ArchiveJob <$> arbitrary
+ Luxi.ReqAutoArchiveJobs -> Luxi.AutoArchiveJobs <$> arbitrary <*>
+ arbitrary
+ Luxi.ReqCancelJob -> Luxi.CancelJob <$> arbitrary
+ Luxi.ReqSetDrainFlag -> Luxi.SetDrainFlag <$> arbitrary
+ Luxi.ReqSetWatcherPause -> Luxi.SetWatcherPause <$> arbitrary
+
+-- | Simple check that encoding/decoding of LuxiOp works.
+prop_Luxi_CallEncoding :: Luxi.LuxiOp -> Property
+prop_Luxi_CallEncoding op =
+ (Luxi.validateCall (Luxi.buildCall op) >>= Luxi.decodeCall) ==? Types.Ok op
+
+testSuite "LUXI"
+ [ 'prop_Luxi_CallEncoding
+ ]
+
+-- * Ssconf tests
+
+instance Arbitrary Ssconf.SSKey where
+ arbitrary = elements [minBound..maxBound]
+
+prop_Ssconf_filename key =
+ printTestCase "Key doesn't start with correct prefix" $
+ Ssconf.sSFilePrefix `isPrefixOf` Ssconf.keyToFilename (Just "") key
+
+testSuite "Ssconf"
+ [ 'prop_Ssconf_filename
+ ]
projects / ganeti-local / blobdiff