, testInstance
, testNode
, testText
+ , testSimu
, testOpCodes
, testJobs
, testCluster
, testLoader
, testTypes
+ , testCLI
+ , testJSON
+ , testLUXI
+ , testSsconf
) where
import Test.QuickCheck
+import Text.Printf (printf)
import Data.List (findIndex, intercalate, nub, isPrefixOf)
+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 Data.IntMap as IntMap
+
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
import qualified Ganeti.HTools.Rapi
-import qualified Ganeti.HTools.Simu
+import qualified Ganeti.HTools.Simu as Simu
import qualified Ganeti.HTools.Text as Text
import qualified Ganeti.HTools.Types as Types
import qualified Ganeti.HTools.Utils as Utils
import qualified Ganeti.HTools.Version
import qualified Ganeti.Constants as C
+import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Program.Hail
import qualified Ganeti.HTools.Program.Hbal
import qualified Ganeti.HTools.Program.Hscan
maxCpu :: Int
maxCpu = 1024
+-- | Max vcpu ratio (random value).
+maxVcpuRatio :: Double
+maxVcpuRatio = 1024.0
+
+-- | Max spindle ratio (random value).
+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]
+
-- | Null iPolicy, and by null we mean very liberal.
nullIPolicy = Types.IPolicy
{ Types.iPolicyMinSpec = Types.ISpec { Types.iSpecMemorySize = 0
, Types.iSpecDiskSize = 0
, Types.iSpecDiskCount = 0
, Types.iSpecNicCount = 0
+ , Types.iSpecSpindleUse = 0
}
, Types.iPolicyMaxSpec = Types.ISpec { Types.iSpecMemorySize = maxBound
, Types.iSpecCpuCount = maxBound
, Types.iSpecDiskSize = maxBound
, Types.iSpecDiskCount = C.maxDisks
, Types.iSpecNicCount = C.maxNics
+ , Types.iSpecSpindleUse = maxBound
}
, Types.iPolicyStdSpec = Types.ISpec { Types.iSpecMemorySize = Types.unitMem
, Types.iSpecCpuCount = Types.unitCpu
, Types.iSpecDiskSize = Types.unitDsk
, Types.iSpecDiskCount = 1
, Types.iSpecNicCount = 1
+ , Types.iSpecSpindleUse = 1
}
- , Types.iPolicyDiskTemplates = [Types.DTDrbd8, Types.DTPlain]
+ , Types.iPolicyDiskTemplates = [minBound..maxBound]
+ , Types.iPolicyVcpuRatio = maxVcpuRatio -- somewhat random value, high
+ -- enough to not impact us
+ , Types.iPolicySpindleRatio = maxSpindleRatio
}
, Instance.vcpus = Node.availCpu node `div` 2
}
--- | Check if an instance is smaller than a node.
-isInstanceSmallerThanNode node inst =
- Instance.mem inst <= Node.availMem node `div` 2 &&
- Instance.dsk inst <= Node.availDisk node `div` 2 &&
- Instance.vcpus inst <= Node.availCpu node `div` 2
-
-- | Create an instance given its spec.
createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
- Types.DTDrbd8
+ Types.DTDrbd8 1
-- | Create a small cluster by repeating a node spec.
makeSmallCluster :: Node.Node -> Int -> Node.List
newelem <- arbitrary `suchThat` (`notElem` lst)
return (newelem:lst)) [] [1..cnt]
+-- | Checks if an instance is mirrored.
+isMirrored :: Instance.Instance -> Bool
+isMirrored = (/= Types.MirrorNone) . Instance.mirrorType
+
+-- | Returns the possible change node types for a disk template.
+evacModeOptions :: Types.MirrorType -> [Types.EvacMode]
+evacModeOptions Types.MirrorNone = []
+evacModeOptions Types.MirrorInternal = [minBound..maxBound] -- DRBD can do all
+evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
+
-- * Arbitrary instances
-- | Defines a DNS name.
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 }
instance Arbitrary Types.InstanceStatus where
arbitrary = elements [minBound..maxBound]
+-- | Generates a random instance with maximum disk/mem/cpu values.
+genInstanceSmallerThan :: Int -> Int -> Int -> Gen Instance.Instance
+genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do
+ name <- getFQDN
+ mem <- choose (0, lim_mem)
+ dsk <- choose (0, lim_dsk)
+ run_st <- arbitrary
+ pn <- arbitrary
+ sn <- arbitrary
+ vcpus <- choose (0, lim_cpu)
+ dt <- arbitrary
+ return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1
+
+-- | Generates an instance smaller than a node.
+genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
+genInstanceSmallerThanNode node =
+ genInstanceSmallerThan (Node.availMem node `div` 2)
+ (Node.availDisk node `div` 2)
+ (Node.availCpu node `div` 2)
+
-- let's generate a random instance
instance Arbitrary Instance.Instance where
- arbitrary = do
- name <- getFQDN
- mem <- choose (0, maxMem)
- dsk <- choose (0, maxDsk)
- run_st <- arbitrary
- pn <- arbitrary
- sn <- arbitrary
- vcpus <- choose (0, maxCpu)
- return $ Instance.create name mem dsk vcpus run_st [] True pn sn
- Types.DTDrbd8
+ arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu
-- | Generas an arbitrary node based on sizing information.
genNode :: Maybe Int -- ^ Minimum node size in terms of units
cpu_t <- choose (base_cpu, top_cpu)
offl <- arbitrary
let n = Node.create name (fromIntegral mem_t) mem_n mem_f
- (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0
+ (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 1 0
n' = Node.setPolicy nullIPolicy n
return $ Node.buildPeers n' Container.empty
]
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
- mem <- arbitrary::Gen (NonNegative Int)
+ mem_s <- arbitrary::Gen (NonNegative Int)
dsk_c <- arbitrary::Gen (NonNegative Int)
dsk_s <- arbitrary::Gen (NonNegative Int)
- cpu <- arbitrary::Gen (NonNegative Int)
- nic <- arbitrary::Gen (NonNegative Int)
- return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem
- , Types.iSpecCpuCount = fromIntegral cpu
+ cpu_c <- arbitrary::Gen (NonNegative Int)
+ nic_c <- arbitrary::Gen (NonNegative Int)
+ su <- arbitrary::Gen (NonNegative Int)
+ return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
+ , Types.iSpecCpuCount = fromIntegral cpu_c
, Types.iSpecDiskSize = fromIntegral dsk_s
, Types.iSpecDiskCount = fromIntegral dsk_c
- , Types.iSpecNicCount = fromIntegral nic
+ , Types.iSpecNicCount = fromIntegral nic_c
+ , Types.iSpecSpindleUse = fromIntegral su
}
--- | Helper function to check whether a spec is LTE than another
-iSpecSmaller :: Types.ISpec -> Types.ISpec -> Bool
-iSpecSmaller imin imax =
- Types.iSpecMemorySize imin <= Types.iSpecMemorySize imax &&
- Types.iSpecCpuCount imin <= Types.iSpecCpuCount imax &&
- Types.iSpecDiskSize imin <= Types.iSpecDiskSize imax &&
- Types.iSpecDiskCount imin <= Types.iSpecDiskCount imax &&
- Types.iSpecNicCount imin <= Types.iSpecNicCount imax
+-- | Generates an ispec bigger than the given one.
+genBiggerISpec :: Types.ISpec -> Gen Types.ISpec
+genBiggerISpec imin = do
+ mem_s <- choose (Types.iSpecMemorySize imin, maxBound)
+ dsk_c <- choose (Types.iSpecDiskCount imin, maxBound)
+ dsk_s <- choose (Types.iSpecDiskSize imin, maxBound)
+ cpu_c <- choose (Types.iSpecCpuCount imin, maxBound)
+ nic_c <- choose (Types.iSpecNicCount imin, maxBound)
+ su <- choose (Types.iSpecSpindleUse imin, maxBound)
+ return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
+ , Types.iSpecCpuCount = fromIntegral cpu_c
+ , Types.iSpecDiskSize = fromIntegral dsk_s
+ , Types.iSpecDiskCount = fromIntegral dsk_c
+ , Types.iSpecNicCount = fromIntegral nic_c
+ , Types.iSpecSpindleUse = fromIntegral su
+ }
instance Arbitrary Types.IPolicy where
arbitrary = do
imin <- arbitrary
- istd <- arbitrary `suchThat` (iSpecSmaller imin)
- imax <- arbitrary `suchThat` (iSpecSmaller istd)
- dts <- arbitrary
+ istd <- genBiggerISpec imin
+ imax <- genBiggerISpec istd
+ num_tmpl <- choose (0, length allDiskTemplates)
+ dts <- genUniquesList num_tmpl
+ vcpu_ratio <- choose (1.0, maxVcpuRatio)
+ spindle_ratio <- choose (1.0, maxSpindleRatio)
return Types.IPolicy { Types.iPolicyMinSpec = imin
, Types.iPolicyStdSpec = istd
, Types.iPolicyMaxSpec = imax
, Types.iPolicyDiskTemplates = dts
+ , Types.iPolicyVcpuRatio = vcpu_ratio
+ , Types.iPolicySpindleRatio = spindle_ratio
}
-- * Actual tests
-- ** Utils tests
+-- | Helper to generate a small string that doesn't contain commas.
+genNonCommaString = do
+ size <- choose (0, 20) -- arbitrary max size
+ vectorOf size (arbitrary `suchThat` ((/=) ','))
+
-- | If the list is not just an empty element, and if the elements do
-- not contain commas, then join+split should be idempotent.
prop_Utils_commaJoinSplit =
- forAll (arbitrary `suchThat`
- (\l -> l /= [""] && all (notElem ',') l )) $ \lst ->
+ forAll (choose (0, 20)) $ \llen ->
+ forAll (vectorOf llen genNonCommaString `suchThat` ((/=) [""])) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
-- | Split and join should always be idempotent.
cndlist = flist ++ tlist ++ [undefined]
prop_Utils_parseUnit (NonNegative n) =
- Utils.parseUnit (show n) == Types.Ok n &&
- Utils.parseUnit (show n ++ "m") == Types.Ok n &&
- (case Utils.parseUnit (show n ++ "M") of
- Types.Ok m -> if n > 0
- then m < n -- for positive values, X MB is < than X MiB
- else m == 0 -- but for 0, 0 MB == 0 MiB
- Types.Bad _ -> False) &&
- Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
- Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
- Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
- where _types = n::Int
+ Utils.parseUnit (show n) ==? Types.Ok n .&&.
+ Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&.
+ Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
+ Utils.parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&.
+ Utils.parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&.
+ Utils.parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&.
+ Utils.parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&.
+ printTestCase "Internal error/overflow?"
+ (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&.
+ property (Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int))
+ where _types = (n::Int)
+ n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
+ n_gb = n_mb * 1000
+ n_tb = n_gb * 1000
-- | Test list for the Utils module.
testSuite "Utils"
-- | 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
, 'prop_Instance_setMovable
]
--- ** Text backend tests
+-- ** Backends
+
+-- *** Text backend tests
-- Instance text loader tests
prop_Text_Load_Instance name mem dsk vcpus status
(NonEmpty pnode) snode
- (NonNegative pdx) (NonNegative sdx) autobal dt =
+ (NonNegative pdx) (NonNegative sdx) autobal dt su =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
mem_s = show mem
+ su_s = show su
status_s = Types.instanceStatusToRaw status
ndx = if null snode
then [(pnode, pdx)]
sdt = Types.diskTemplateToRaw dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
- sbal, pnode, snode, sdt, tags]
+ sbal, pnode, snode, sdt, tags, su_s]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags]
then Node.noSecondary
else sdx) &&
Instance.autoBalance i == autobal &&
+ Instance.spindleUse i == su &&
Types.isBad fail1
prop_Text_Load_InstanceFail ktn fields =
- length fields /= 10 ==>
+ length fields /= 10 && length fields /= 11 ==>
case Text.loadInst nl fields of
Types.Ok _ -> failTest "Managed to load instance from invalid data"
Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
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 { Node.failN1 = True, Node.offline = False
- , Node.iPolicy = Types.defIPolicy }
+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 ',' .
-- small cluster sizes.
prop_Text_CreateSerialise =
forAll genTags $ \ctags ->
- forAll (choose (1, 2)) $ \reqnodes ->
forAll (choose (1, 20)) $ \maxiter ->
forAll (choose (2, 10)) $ \count ->
forAll genOnlineNode $ \node ->
- forAll (arbitrary `suchThat` isInstanceSmallerThanNode node) $ \inst ->
- let inst' = Instance.setMovable inst $ Utils.if' (reqnodes == 2) True False
- nl = makeSmallCluster node count
+ forAll (genInstanceSmallerThanNode node) $ \inst ->
+ let nl = makeSmallCluster node count
+ reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
- Cluster.iterateAlloc nl Container.empty (Just maxiter) inst' allocn [] []
+ Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
of
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
Types.Ok (_, _, _, [], _) -> printTestCase
, 'prop_Text_CreateSerialise
]
+-- *** Simu backend
+
+-- | Generates a tuple of specs for simulation.
+genSimuSpec :: Gen (String, Int, Int, Int, Int)
+genSimuSpec = do
+ pol <- elements [C.allocPolicyPreferred,
+ C.allocPolicyLastResort, C.allocPolicyUnallocable,
+ "p", "a", "u"]
+ -- should be reasonable (nodes/group), bigger values only complicate
+ -- the display of failed tests, and we don't care (in this particular
+ -- test) about big node groups
+ nodes <- choose (0, 20)
+ dsk <- choose (0, maxDsk)
+ mem <- choose (0, maxMem)
+ cpu <- choose (0, maxCpu)
+ return (pol, nodes, dsk, mem, cpu)
+
+-- | Checks that given a set of corrects specs, we can load them
+-- successfully, and that at high-level the values look right.
+prop_SimuLoad =
+ forAll (choose (0, 10)) $ \ngroups ->
+ forAll (replicateM ngroups genSimuSpec) $ \specs ->
+ let strspecs = map (\(p, n, d, m, c) -> printf "%s,%d,%d,%d,%d"
+ p n d m c::String) specs
+ totnodes = sum $ map (\(_, n, _, _, _) -> n) specs
+ mdc_in = concatMap (\(_, n, d, m, c) ->
+ replicate n (fromIntegral m, fromIntegral d,
+ fromIntegral c,
+ fromIntegral m, fromIntegral d)) specs
+ in case Simu.parseData strspecs of
+ Types.Bad msg -> failTest $ "Failed to load specs: " ++ msg
+ Types.Ok (Loader.ClusterData gl nl il tags ipol) ->
+ let nodes = map snd $ IntMap.toAscList nl
+ nidx = map Node.idx nodes
+ mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
+ Node.fMem n, Node.fDsk n)) nodes
+ in
+ Container.size gl ==? ngroups .&&.
+ Container.size nl ==? totnodes .&&.
+ Container.size il ==? 0 .&&.
+ length tags ==? 0 .&&.
+ ipol ==? Types.defIPolicy .&&.
+ nidx ==? [1..totnodes] .&&.
+ mdc_in ==? mdc_out .&&.
+ map Group.iPolicy (Container.elems gl) ==?
+ replicate ngroups Types.defIPolicy
+
+testSuite "Simu"
+ [ 'prop_SimuLoad
+ ]
+
-- ** Node tests
prop_Node_setAlias node name =
where newnode = Node.setXmem node xm
prop_Node_setMcpu node mc =
- Node.mCpu newnode ==? mc
+ Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
where newnode = Node.setMcpu node mc
-- | Check that an instance add with too high memory or disk will be
-- rejected.
prop_Node_addPriFM node inst =
Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
- not (Instance.instanceOffline inst) ==>
+ not (Instance.isOffline inst) ==>
case Node.addPri node inst'' of
Types.OpFail Types.FailMem -> True
_ -> False
inst' = setInstanceSmallerThanNode node inst
inst'' = inst' { Instance.mem = Instance.mem inst }
+-- | Check that adding a primary instance with too much disk fails
+-- with type FailDisk.
prop_Node_addPriFD node inst =
+ forAll (elements Instance.localStorageTemplates) $ \dt ->
Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
- case Node.addPri node inst'' of
- Types.OpFail Types.FailDisk -> True
- _ -> False
- where _types = (node::Node.Node, inst::Instance.Instance)
- inst' = setInstanceSmallerThanNode node inst
- inst'' = inst' { Instance.dsk = Instance.dsk inst }
-
-prop_Node_addPriFC node inst (Positive extra) =
- not (Node.failN1 node) && not (Instance.instanceOffline inst) ==>
- case Node.addPri node inst'' of
- Types.OpFail Types.FailCPU -> True
- _ -> False
- where _types = (node::Node.Node, inst::Instance.Instance)
- inst' = setInstanceSmallerThanNode node inst
- inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
+ let inst' = setInstanceSmallerThanNode node inst
+ inst'' = inst' { Instance.dsk = Instance.dsk inst
+ , Instance.diskTemplate = dt }
+ in case Node.addPri node inst'' of
+ Types.OpFail Types.FailDisk -> True
+ _ -> False
+
+-- | Check that adding a primary instance with too many VCPUs fails
+-- with type FailCPU.
+prop_Node_addPriFC =
+ forAll (choose (1, maxCpu)) $ \extra ->
+ forAll genOnlineNode $ \node ->
+ forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
+ let inst' = setInstanceSmallerThanNode node inst
+ inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
+ in case Node.addPri node inst'' of
+ Types.OpFail Types.FailCPU -> property True
+ v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
-- | Check that an instance add with too high memory or disk will be
-- rejected.
prop_Node_addSec node inst pdx =
((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
- not (Instance.instanceOffline inst)) ||
+ not (Instance.isOffline inst)) ||
Instance.dsk inst >= Node.fDsk node) &&
not (Node.failN1 node) ==>
isFailure (Node.addSec node inst pdx)
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
--- | Check that an offline instance with reasonable disk size can always
--- be added.
-prop_Node_addPriOffline =
- forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node ->
- forAll (arbitrary `suchThat`
- (\ x -> (Instance.dsk x < Node.fDsk node) &&
- Instance.instanceOffline x)) $ \inst ->
- case Node.addPri node inst of
- Types.OpGood _ -> True
- _ -> False
-
-prop_Node_addSecOffline pdx =
+-- | Check that an offline instance with reasonable disk size but
+-- extra mem/cpu can always be added.
+prop_Node_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
forAll genOnlineNode $ \node ->
- forAll (arbitrary `suchThat`
- (\ inst -> Instance.dsk inst < Node.availDisk node)) $ \inst ->
- case Node.addSec node (inst { Instance.runSt = Types.AdminOffline }) pdx of
- Types.OpGood _ -> True
- _ -> False
+ forAll (genInstanceSmallerThanNode node) $ \inst ->
+ let inst' = inst { Instance.runSt = Types.AdminOffline
+ , Instance.mem = Node.availMem node + extra_mem
+ , Instance.vcpus = Node.availCpu node + extra_cpu }
+ in case Node.addPri node inst' of
+ Types.OpGood _ -> property True
+ v -> failTest $ "Expected OpGood, but got: " ++ show v
+
+-- | Check that an offline instance with reasonable disk size but
+-- extra mem/cpu can always be added.
+prop_Node_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
+ forAll genOnlineNode $ \node ->
+ forAll (genInstanceSmallerThanNode node) $ \inst ->
+ let inst' = inst { Instance.runSt = Types.AdminOffline
+ , Instance.mem = Node.availMem node + extra_mem
+ , Instance.vcpus = Node.availCpu node + extra_cpu
+ , Instance.diskTemplate = Types.DTDrbd8 }
+ in case Node.addSec node inst' pdx of
+ Types.OpGood _ -> property True
+ v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
-- | Checks for memory reservation changes.
prop_Node_rMem inst =
- not (Instance.instanceOffline inst) ==>
- forAll (arbitrary `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
+ not (Instance.isOffline inst) ==>
+ forAll (genOnlineNode `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
-- ab = auto_balance, nb = non-auto_balance
-- we use -1 as the primary node of the instance
- let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
+ let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True
+ , Instance.diskTemplate = Types.DTDrbd8 }
inst_ab = setInstanceSmallerThanNode node inst'
inst_nb = inst_ab { Instance.autoBalance = False }
-- now we have the two instances, identical except the
SmallRatio mx' = mx
-- Check tag maps
-prop_Node_tagMaps_idempotent tags =
+prop_Node_tagMaps_idempotent =
+ forAll genTags $ \tags ->
Node.delTags (Node.addTags m tags) tags ==? m
where m = Data.Map.empty
-prop_Node_tagMaps_reject tags =
- not (null tags) ==>
- all (\t -> Node.rejectAddTags m [t]) tags
- where m = Node.addTags Data.Map.empty tags
+prop_Node_tagMaps_reject =
+ forAll (genTags `suchThat` (not . null)) $ \tags ->
+ let m = Node.addTags Data.Map.empty tags
+ in all (\t -> Node.rejectAddTags m [t]) tags
prop_Node_showField node =
forAll (elements Node.defaultFields) $ \ field ->
length (nub onlyuuid) == length onlyuuid &&
(null nodes || not (null ng))
+-- Check idempotence of add/remove operations
+prop_Node_addPri_idempotent =
+ forAll genOnlineNode $ \node ->
+ forAll (genInstanceSmallerThanNode node) $ \inst ->
+ case Node.addPri node inst of
+ Types.OpGood node' -> Node.removePri node' inst ==? node
+ _ -> failTest "Can't add instance"
+
+prop_Node_addSec_idempotent =
+ forAll genOnlineNode $ \node ->
+ forAll (genInstanceSmallerThanNode node) $ \inst ->
+ let pdx = Node.idx node + 1
+ inst' = Instance.setPri inst pdx
+ inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
+ in case Node.addSec node inst'' pdx of
+ Types.OpGood node' -> Node.removeSec node' inst'' ==? node
+ _ -> failTest "Can't add instance"
+
testSuite "Node"
[ 'prop_Node_setAlias
, 'prop_Node_setOffline
, 'prop_Node_addPriFD
, 'prop_Node_addPriFC
, 'prop_Node_addSec
- , 'prop_Node_addPriOffline
- , 'prop_Node_addSecOffline
+ , 'prop_Node_addOfflinePri
+ , 'prop_Node_addOfflineSec
, 'prop_Node_rMem
, 'prop_Node_setMdsk
, 'prop_Node_tagMaps_idempotent
, 'prop_Node_tagMaps_reject
, 'prop_Node_showField
, 'prop_Node_computeGroups
+ , 'prop_Node_addPri_idempotent
+ , 'prop_Node_addSec_idempotent
]
-- ** Cluster tests
forAll (choose (5, 20)) $ \count ->
forAll genOnlineNode $ \node ->
let (nl, il, inst') = makeSmallEmptyCluster node count inst
- in case Cluster.genAllocNodes defGroupList nl 2 True >>=
+ reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
+ in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl il inst' of
Types.Bad _ -> False
Types.Ok as ->
-- | Checks that on a 2-5 node cluster, we can allocate a random
-- instance spec via tiered allocation (whatever the original instance
--- spec), on either one or two nodes.
+-- spec), on either one or two nodes. Furthermore, we test that
+-- computed allocation statistics are correct.
prop_ClusterCanTieredAlloc inst =
forAll (choose (2, 5)) $ \count ->
- forAll (choose (1, 2)) $ \rqnodes ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
let nl = makeSmallCluster node count
il = Container.empty
+ rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' ->
Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
- Types.Bad _ -> False
- Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
- IntMap.size il' == length ixes &&
- length ixes == length cstats
+ Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
+ Types.Ok (_, nl', il', ixes, cstats) ->
+ let (ai_alloc, ai_pool, ai_unav) =
+ Cluster.computeAllocationDelta
+ (Cluster.totalResources nl)
+ (Cluster.totalResources nl')
+ all_nodes = Container.elems nl
+ in property (not (null ixes)) .&&.
+ IntMap.size il' ==? length ixes .&&.
+ length ixes ==? length cstats .&&.
+ sum (map Types.allocInfoVCpus [ai_alloc, ai_pool, ai_unav]) ==?
+ sum (map Node.hiCpu all_nodes) .&&.
+ sum (map Types.allocInfoNCpus [ai_alloc, ai_pool, ai_unav]) ==?
+ sum (map Node.tCpu all_nodes) .&&.
+ sum (map Types.allocInfoMem [ai_alloc, ai_pool, ai_unav]) ==?
+ truncate (sum (map Node.tMem all_nodes)) .&&.
+ sum (map Types.allocInfoDisk [ai_alloc, ai_pool, ai_unav]) ==?
+ truncate (sum (map Node.tDsk all_nodes))
-- | Helper function to create a cluster with the given range of nodes
-- and allocate an instance on it.
genClusterAlloc count node inst =
let nl = makeSmallCluster node count
- in case Cluster.genAllocNodes defGroupList nl 2 True >>=
+ reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
+ in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of
Types.Bad _ -> Types.Bad "Can't allocate"
Types.Ok as ->
prop_ClusterAllocRelocate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
- forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
+ forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
case IAlloc.processRelocate defGroupList nl il
- (Instance.idx inst) 1 [Instance.sNode inst'] of
- Types.Ok _ -> printTestCase "??" True -- huh, how to make
- -- this nicer...
+ (Instance.idx inst) 1
+ [(if Instance.diskTemplate inst' == Types.DTDrbd8
+ then Instance.sNode
+ else Instance.pNode) inst'] of
+ Types.Ok _ -> property True
Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
-- | Helper property checker for the result of a nodeEvac or
prop_ClusterAllocEvacuate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
- forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
+ forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
conjoin $ map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode
- [Instance.idx inst']) [minBound..maxBound]
+ [Instance.idx 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_ClusterAllocChangeGroup =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
- forAll (arbitrary `suchThat` (isInstanceSmallerThanNode node)) $ \inst ->
+ forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
Loader.lookupInstance il inst ==? Data.Map.lookup inst il
where il = Data.Map.fromList kti
-prop_Loader_assignIndices nodes =
- Data.Map.size nassoc == length nodes &&
- Container.size kt == length nodes &&
- (if not (null nodes)
- then maximum (IntMap.keys kt) == length nodes - 1
- else True)
- where (nassoc, kt) =
- Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
+prop_Loader_assignIndices =
+ -- generate nodes with unique names
+ forAll (arbitrary `suchThat`
+ (\nodes ->
+ let names = map Node.name nodes
+ in length names == length (nub names))) $ \nodes ->
+ let (nassoc, kt) =
+ Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
+ in Data.Map.size nassoc == length nodes &&
+ Container.size kt == length nodes &&
+ if not (null nodes)
+ then maximum (IntMap.keys kt) == length nodes - 1
+ else True
-- | Checks that the number of primary instances recorded on the nodes
-- is zero.
, 'prop_Types_opToResult
, 'prop_Types_eitherToResult
]
+
+-- ** CLI tests
+
+-- | Test correct parsing.
+prop_CLI_parseISpec descr dsk mem cpu =
+ let str = printf "%d,%d,%d" dsk mem cpu
+ in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
+
+-- | Test parsing failure due to wrong section count.
+prop_CLI_parseISpecFail descr =
+ forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
+ forAll (replicateM nelems arbitrary) $ \values ->
+ let str = intercalate "," $ map show (values::[Int])
+ in case CLI.parseISpecString descr str of
+ Types.Ok v -> failTest $ "Expected failure, got " ++ show v
+ _ -> property True
+
+-- | Test parseYesNo.
+prop_CLI_parseYesNo def testval val =
+ forAll (elements [val, "yes", "no"]) $ \actual_val ->
+ if testval
+ then CLI.parseYesNo def Nothing ==? Types.Ok def
+ else let result = CLI.parseYesNo def (Just actual_val)
+ in if actual_val `elem` ["yes", "no"]
+ then result ==? Types.Ok (actual_val == "yes")
+ else property $ Types.isBad result
+
+-- | Helper to check for correct parsing of string arg.
+checkStringArg val (opt, fn) =
+ let GetOpt.Option _ longs _ _ = opt
+ in case longs of
+ [] -> failTest "no long options?"
+ cmdarg:_ ->
+ case CLI.parseOptsInner ["--" ++ cmdarg ++ "=" ++ val] "prog" [opt] of
+ Left e -> failTest $ "Failed to parse option: " ++ show e
+ Right (options, _) -> fn options ==? Just val
+
+-- | Test a few string arguments.
+prop_CLI_StringArg argument =
+ let args = [ (CLI.oDataFile, CLI.optDataFile)
+ , (CLI.oDynuFile, CLI.optDynuFile)
+ , (CLI.oSaveCluster, CLI.optSaveCluster)
+ , (CLI.oReplay, CLI.optReplay)
+ , (CLI.oPrintCommands, CLI.optShowCmds)
+ , (CLI.oLuxiSocket, CLI.optLuxi)
+ ]
+ in conjoin $ map (checkStringArg argument) args
+
+-- | Helper to test that a given option is accepted OK with quick exit.
+checkEarlyExit name options param =
+ case CLI.parseOptsInner [param] name options of
+ Left (code, _) -> if code == 0
+ then property True
+ else failTest $ "Program " ++ name ++
+ " returns invalid code " ++ show code ++
+ " for option " ++ param
+ _ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++
+ param ++ " as early exit one"
+
+-- | Test that all binaries support some common options. There is
+-- nothing actually random about this test...
+prop_CLI_stdopts =
+ let params = ["-h", "--help", "-V", "--version"]
+ opts = map (\(name, (_, o)) -> (name, o)) Program.personalities
+ -- apply checkEarlyExit across the cartesian product of params and opts
+ in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts]
+
+testSuite "CLI"
+ [ 'prop_CLI_parseISpec
+ , 'prop_CLI_parseISpecFail
+ , 'prop_CLI_parseYesNo
+ , '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