-{-| Unittests for ganeti-htools
+{-| Unittests for ganeti-htools.
-}
, testJobs
, testCluster
, testLoader
+ , testTypes
) where
import Test.QuickCheck
-- * Constants
--- | Maximum memory (1TiB, somewhat random value)
+-- | Maximum memory (1TiB, somewhat random value).
maxMem :: Int
maxMem = 1024 * 1024
--- | Maximum disk (8TiB, somewhat random value)
+-- | Maximum disk (8TiB, somewhat random value).
maxDsk :: Int
maxDsk = 1024 * 1024 * 8
--- | Max CPUs (1024, somewhat random value)
+-- | Max CPUs (1024, somewhat random value).
maxCpu :: Int
maxCpu = 1024
-- * Helper functions
--- | Simple checker for whether OpResult is fail or pass
+-- | Simple checker for whether OpResult is fail or pass.
isFailure :: Types.OpResult a -> Bool
isFailure (Types.OpFail _) = True
isFailure _ = False
--- | Update an instance to be smaller than a node
+-- | Update an instance to be smaller than a node.
setInstanceSmallerThanNode node inst =
inst { Instance.mem = Node.availMem node `div` 2
, Instance.dsk = Node.availDisk node `div` 2
, Instance.vcpus = Node.availCpu node `div` 2
}
--- | Create an instance given its spec
+-- | Create an instance given its spec.
createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1)
+ Types.DTDrbd8
--- | Create a small cluster by repeating a node spec
+-- | Create a small cluster by repeating a node spec.
makeSmallCluster :: Node.Node -> Int -> Node.List
makeSmallCluster node count =
let fn = Node.buildPeers node Container.empty
(_, nlst) = Loader.assignIndices namelst
in nlst
--- | Checks if a node is "big" enough
+-- | Checks if a node is "big" enough.
isNodeBig :: Node.Node -> Int -> Bool
isNodeBig node size = Node.availDisk node > size * Types.unitDsk
&& Node.availMem node > size * Types.unitMem
canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
-- | Assigns a new fresh instance to a cluster; this is not
--- allocation, so no resource checks are done
+-- allocation, so no resource checks are done.
assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
Types.Idx -> Types.Idx ->
(Node.List, Instance.List)
-- * Arbitrary instances
+-- | Defines a DNS name.
newtype DNSChar = DNSChar { dnsGetChar::Char }
+
instance Arbitrary DNSChar where
arbitrary = do
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
sn <- arbitrary
vcpus <- choose (0, maxCpu)
return $ Instance.create name mem dsk vcpus run_st [] True pn sn
+ Types.DTDrbd8
-genNode :: Maybe Int -> Maybe Int -> Gen Node.Node
+-- | Generas an arbitrary node based on sizing information.
+genNode :: Maybe Int -- ^ Minimum node size in terms of units
+ -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
+ -- just by the max... constants)
+ -> Gen Node.Node
genNode min_multiplier max_multiplier = do
let (base_mem, base_dsk, base_cpu) =
case min_multiplier of
instance Arbitrary Jobs.JobStatus where
arbitrary = elements [minBound..maxBound]
+newtype SmallRatio = SmallRatio Double deriving Show
+instance Arbitrary SmallRatio where
+ arbitrary = do
+ v <- choose (0, 1)
+ return $ SmallRatio v
+
+instance Arbitrary Types.AllocPolicy where
+ arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Types.DiskTemplate where
+ arbitrary = elements [minBound..maxBound]
+
-- * Actual tests
--- If the list is not just an empty element, and if the elements do
--- not contain commas, then join+split should be idepotent
+-- ** Utils tests
+
+-- | 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 (not . elem ',') l )) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) == lst
--- Split and join should always be idempotent
+-- | Split and join should always be idempotent.
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
-- | fromObjWithDefault, we test using the Maybe monad and an integer
--- value
+-- value.
prop_Utils_fromObjWithDefault def_value random_key =
-- a missing key will be returned with the default
Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
random_key (def_value+1) == Just def_value
where _types = def_value :: Integer
+-- | Test that functional if' behaves like the syntactic sugar if.
+prop_Utils_if'if :: Bool -> Int -> Int -> Bool
+prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
+
+-- | Test basic select functionality
+prop_Utils_select :: Int -- ^ Default result
+ -> [Int] -- ^ List of False values
+ -> [Int] -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select def lst1 lst2 =
+ Utils.select def cndlist == expectedresult
+ where expectedresult = Utils.if' (null lst2) def (head lst2)
+ flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ cndlist = flist ++ tlist
+
+-- | Test basic select functionality with undefined default
+prop_Utils_select_undefd :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select_undefd lst1 (NonEmpty lst2) =
+ Utils.select undefined cndlist == head lst2
+ where flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ cndlist = flist ++ tlist
+
+-- | Test basic select functionality with undefined list values
+prop_Utils_select_undefv :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select_undefv lst1 (NonEmpty lst2) =
+ Utils.select undefined cndlist == head lst2
+ where flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ 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 less 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)
+
+-- | Test list for the Utils module.
testUtils =
[ run prop_Utils_commaJoinSplit
, run prop_Utils_commaSplitJoin
, run prop_Utils_fromObjWithDefault
+ , run prop_Utils_if'if
+ , run prop_Utils_select
+ , run prop_Utils_select_undefd
+ , run prop_Utils_select_undefv
+ , run prop_Utils_parseUnit
]
--- | Make sure add is idempotent
+-- ** PeerMap tests
+
+-- | Make sure add is idempotent.
prop_PeerMap_addIdempotent pmap key em =
fn puniq == fn (fn puniq)
where _types = (pmap::PeerMap.PeerMap,
fn = PeerMap.add key em
puniq = PeerMap.accumArray const pmap
--- | Make sure remove is idempotent
+-- | Make sure remove is idempotent.
prop_PeerMap_removeIdempotent pmap key =
fn puniq == fn (fn puniq)
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
fn = PeerMap.remove key
puniq = PeerMap.accumArray const pmap
--- | Make sure a missing item returns 0
+-- | Make sure a missing item returns 0.
prop_PeerMap_findMissing pmap key =
PeerMap.find key (PeerMap.remove key puniq) == 0
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
puniq = PeerMap.accumArray const pmap
--- | Make sure an added item is found
+-- | Make sure an added item is found.
prop_PeerMap_addFind pmap key em =
PeerMap.find key (PeerMap.add key em puniq) == em
where _types = (pmap::PeerMap.PeerMap,
key::PeerMap.Key, em::PeerMap.Elem)
puniq = PeerMap.accumArray const pmap
--- | Manual check that maxElem returns the maximum indeed, or 0 for null
+-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
prop_PeerMap_maxElem pmap =
PeerMap.maxElem puniq == if null puniq then 0
else (maximum . snd . unzip) puniq
where _types = pmap::PeerMap.PeerMap
puniq = PeerMap.accumArray const pmap
+-- | List of tests for the PeerMap module.
testPeerMap =
[ run prop_PeerMap_addIdempotent
, run prop_PeerMap_removeIdempotent
, run prop_PeerMap_findMissing
]
--- Container tests
+-- ** Container tests
prop_Container_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 cont &&
fnode = head (Container.elems nl)
in Container.nameOf nl (Node.idx fnode) == Node.name fnode
--- We test that in a cluster, given a random node, we can find it by
+-- | 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
+-- and that we fail to find a non-existing name.
prop_Container_findByName node othername =
forAll (choose (1, 20)) $ \ cnt ->
forAll (choose (0, cnt - 1)) $ \ fidx ->
, run prop_Container_findByName
]
+-- ** Instance tests
+
-- Simple instance tests, we only have setter/getters
prop_Instance_creat inst =
, run prop_Instance_setMovable
]
+-- ** Text backend tests
+
-- Instance text loader tests
prop_Text_Load_Instance name mem dsk vcpus status
(NonEmpty pnode) snode
- (NonNegative pdx) (NonNegative sdx) autobal =
+ (NonNegative pdx) (NonNegative sdx) autobal dt =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
nl = Data.Map.fromList ndx
tags = ""
sbal = if autobal then "Y" else "N"
+ sdt = Types.dtToString dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
- sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
+ sbal, pnode, snode, sdt, tags]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
- sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
+ sbal, pnode, pnode, tags]
_types = ( name::String, mem::Int, dsk::Int
, vcpus::Int, status::String
, snode::String
, autobal::Bool)
in
case inst of
- Nothing -> False
- Just (_, i) ->
+ Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
+ False
+ Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
+ \ loading the instance") $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
Instance.sNode i == (if null snode
then Node.noSecondary
else sdx) &&
- Instance.auto_balance i == autobal &&
- isNothing fail1
+ Instance.autoBalance i == autobal &&
+ Types.isBad fail1
prop_Text_Load_InstanceFail ktn fields =
- length fields /= 9 ==>
+ length fields /= 10 ==>
case Text.loadInst nl fields of
- Types.Ok _ -> False
- Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
+ Types.Ok _ -> printTestCase "Managed to load instance from invalid\
+ \ data" False
+ Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
+ "Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Data.Map.fromList ktn
prop_Text_Load_Node name tm nm fm td fd tc fo =
, run prop_Text_NodeLSIdempotent
]
--- Node tests
+-- ** Node tests
prop_Node_setAlias node name =
Node.name newnode == Node.name node &&
Node.mCpu newnode == mc
where newnode = Node.setMcpu node mc
--- | Check that an instance add with too high memory or disk will be rejected
+-- | 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)
==>
inst' = setInstanceSmallerThanNode node inst
inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
--- | Check that an instance add with too high memory or disk will be rejected
+-- | 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) ||
Instance.dsk inst >= Node.fDsk node) &&
==> isFailure (Node.addSec node inst pdx)
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
--- | Checks for memory reservation changes
-prop_Node_rMem node inst =
+-- | Checks for memory reservation changes.
+prop_Node_rMem inst =
+ forAll (arbitrary `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.auto_balance = True }
+ let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
inst_ab = setInstanceSmallerThanNode node inst'
- inst_nb = inst_ab { Instance.auto_balance = False }
+ inst_nb = inst_ab { Instance.autoBalance = False }
-- now we have the two instances, identical except the
- -- auto_balance attribute
+ -- autoBalance attribute
orig_rmem = Node.rMem node
inst_idx = Instance.idx inst_ab
node_add_ab = Node.addSec node inst_ab (-1)
in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
(Types.OpGood a_ab, Types.OpGood a_nb,
Types.OpGood d_ab, Types.OpGood d_nb) ->
+ printTestCase "Consistency checks failed" $
Node.rMem a_ab > orig_rmem &&
Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
Node.rMem a_nb == orig_rmem &&
-- test as any
inst_idx `elem` Node.sList a_ab &&
not (inst_idx `elem` Node.sList d_ab)
- _ -> False
-
-newtype SmallRatio = SmallRatio Double deriving Show
-instance Arbitrary SmallRatio where
- arbitrary = do
- v <- choose (0, 1)
- return $ SmallRatio v
+ x -> printTestCase ("Failed to add/remove instances: " ++ show x)
+ False
--- | Check mdsk setting
+-- | Check mdsk setting.
prop_Node_setMdsk node mx =
Node.loDsk node' >= 0 &&
fromIntegral (Node.loDsk node') <= Node.tDsk node &&
]
--- Cluster tests
+-- ** Cluster tests
--- | Check that the cluster score is close to zero for a homogeneous cluster
+-- | Check that the cluster score is close to zero for a homogeneous
+-- cluster.
prop_Score_Zero node =
forAll (choose (1, 1024)) $ \count ->
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
let fn = Node.buildPeers node Container.empty
- nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
- nl = Container.fromList nlst
- score = Cluster.compCV nl
+ nlst = replicate count fn
+ score = Cluster.compCVNodes nlst
-- we can't say == 0 here as the floating point errors accumulate;
-- this should be much lower than the default score in CLI.hs
in score <= 1e-12
--- | Check that cluster stats are sane
+-- | Check that cluster stats are sane.
prop_CStats_sane node =
forAll (choose (1, 1024)) $ \count ->
(not (Node.offline node) && not (Node.failN1 node) &&
Cluster.csAdsk cstats <= Cluster.csFdsk cstats
-- | Check that one instance is allocated correctly, without
--- rebalances needed
+-- rebalances needed.
prop_ClusterAlloc_sane node inst =
forAll (choose (5, 20)) $ \count ->
not (Node.offline node)
-- | 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.
prop_ClusterCanTieredAlloc node inst =
forAll (choose (2, 5)) $ \count ->
forAll (choose (1, 2)) $ \rqnodes ->
il = Container.empty
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' ->
- Cluster.tieredAlloc nl il inst allocnodes' [] [] of
+ 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
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
--- we can also evacuate it
+-- we can also evacuate it.
prop_ClusterAllocEvac node inst =
forAll (choose (4, 8)) $ \count ->
not (Node.offline node)
_ -> False
-- | Check that allocating multiple instances on a cluster, then
--- adding an empty node, results in a valid rebalance
+-- adding an empty node, results in a valid rebalance.
prop_ClusterAllocBalance =
forAll (genNode (Just 5) (Just 128)) $ \node ->
forAll (choose (3, 5)) $ \count ->
allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case allocnodes >>= \allocnodes' ->
- Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
+ Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
Types.Bad _ -> False
Types.Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl
tbl = Cluster.Table ynl il' cv []
in canBalance tbl True True False
--- | Checks consistency
+-- | Checks consistency.
prop_ClusterCheckConsistency node inst =
let nl = makeSmallCluster node 3
[node1, node2, node3] = Container.elems nl
null (ccheck [(0, inst2)]) &&
(not . null $ ccheck [(0, inst3)])
--- For now, we only test that we don't lose instances during the split
+-- | For now, we only test that we don't lose instances during the split.
prop_ClusterSplitCluster node inst =
forAll (choose (0, 100)) $ \icnt ->
let nl = makeSmallCluster node 2
, run prop_ClusterSplitCluster
]
--- | Check that opcode serialization is idempotent
+-- ** OpCodes tests
+-- | Check that opcode serialization is idempotent.
prop_OpCodes_serialization op =
case J.readJSON (J.showJSON op) of
J.Error _ -> False
[ run prop_OpCodes_serialization
]
--- | Check that (queued) job\/opcode status serialization is idempotent
+-- ** Jobs tests
+
+-- | Check that (queued) job\/opcode status serialization is idempotent.
prop_OpStatus_serialization os =
case J.readJSON (J.showJSON os) of
J.Error _ -> False
, run prop_JobStatus_serialization
]
--- | Loader tests
+-- ** Loader tests
prop_Loader_lookupNode ktn inst node =
Loader.lookupNode nl inst node == Data.Map.lookup node nl
else True)
where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
-
-- | Checks that the number of primary instances recorded on the nodes
--- is zero
+-- is zero.
prop_Loader_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] []
in (sum . map (length . Node.pList)) nodes == 0 &&
null instances
+-- | Check that compareNameComponent on equal strings works.
+prop_Loader_compareNameComponent_equal :: String -> Bool
+prop_Loader_compareNameComponent_equal s =
+ Loader.compareNameComponent s s ==
+ Loader.LookupResult Loader.ExactMatch s
+
+-- | Check that compareNameComponent on prefix strings works.
+prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
+prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
+ Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
+ Loader.LookupResult Loader.PartialMatch s1
+
testLoader =
[ run prop_Loader_lookupNode
, run prop_Loader_lookupInstance
, run prop_Loader_assignIndices
, run prop_Loader_mergeData
+ , run prop_Loader_compareNameComponent_equal
+ , run prop_Loader_compareNameComponent_prefix
]
+
+-- ** Types tests
+
+prop_AllocPolicy_serialisation apol =
+ case Types.apolFromString (Types.apolToString apol) of
+ Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+ p == apol
+ Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+prop_DiskTemplate_serialisation dt =
+ case Types.dtFromString (Types.dtToString dt) of
+ Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+ p == dt
+ Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+testTypes =
+ [ run prop_AllocPolicy_serialisation
+ , run prop_DiskTemplate_serialisation
+ ]
projects / ganeti-local / blobdiff