Commit 834bea99 authored by Helga Velroyen's avatar Helga Velroyen

Unit tests for Query/Network.hs

This patch adds a couple of unit tests for Query/Network.hs.
Note that they'll need to be adapted, once issue 362 is addressed.
Signed-off-by: default avatarHelga Velroyen <helgav@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent 7dc27988
......@@ -584,6 +584,7 @@ HS_TEST_SRCS = \
test/hs/Test/Ganeti/OpCodes.hs \
test/hs/Test/Ganeti/Query/Filter.hs \
test/hs/Test/Ganeti/Query/Language.hs \
test/hs/Test/Ganeti/Query/Network.hs \
test/hs/Test/Ganeti/Query/Query.hs \
test/hs/Test/Ganeti/Rpc.hs \
test/hs/Test/Ganeti/Runtime.hs \
......
......@@ -24,10 +24,16 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.Query.Network
( NetworkRuntime(..)
( getGroupConnection
, getNetworkUuid
, instIsConnected
, NetworkRuntime(..)
, networkFieldsMap
) where
-- FIXME: everything except NetworkRuntime(..) and networkFieldsMap
-- is only exported for testing.
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.List (find)
......@@ -88,8 +94,7 @@ networkFieldsMap :: FieldMap Network NetworkRuntime
networkFieldsMap =
Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) networkFields
-- TODO: the following fields are not implemented yet: external_reservations,
-- inst_cnt, inst_list
-- TODO: the following fields are not implemented yet: external_reservations
-- | Given a network's UUID, this function lists all connections from
-- the network to nodegroups including the respective mode and links.
......
......@@ -29,7 +29,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Objects
( testObjects
, Node(..)
, genConfigDataWithNetworks
, genEmptyCluster
, genInstWithNets
, genValidNetwork
, genBitStringMaxLen
) where
......@@ -40,6 +42,7 @@ import qualified Test.HUnit as HUnit
import Control.Applicative
import Control.Monad
import Data.Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Text.JSON as J
......@@ -116,6 +119,22 @@ instance Arbitrary Instance where
-- tags
<*> (Set.fromList <$> genTags)
-- | Generates an instance that is connected to the given networks
-- and possibly some other networks
genInstWithNets :: [String] -> Gen Instance
genInstWithNets nets = do
plain_inst <- arbitrary
mac <- arbitrary
ip <- arbitrary
nicparams <- arbitrary
-- generate some more networks than the given ones
num_more_nets <- choose (0,3)
more_nets <- vectorOf num_more_nets genName
let partial_nics = map (PartialNic mac ip nicparams . Just)
(List.nub (nets ++ more_nets))
new_inst = plain_inst { instNics = partial_nics }
return new_inst
-- | FIXME: This generates completely random data, without normal
-- validation rules.
$(genArbitrary ''PartialISpecParams)
......@@ -216,6 +235,24 @@ genEmptyCluster ncount = do
serial
return c
-- | FIXME: make an even simpler base version of creating a cluster.
-- | Generates config data with a couple of networks.
genConfigDataWithNetworks :: ConfigData -> Gen ConfigData
genConfigDataWithNetworks old_cfg = do
num_nets <- choose (0, 3)
-- generate a list of network names (no duplicates)
net_names <- genUniquesList num_nets genName >>= mapM mkNonEmpty
-- generate a random list of networks (possibly with duplicate names)
nets <- vectorOf num_nets genValidNetwork
-- use unique names for the networks
let nets_unique = map ( \(name, net) -> net { networkName = name } )
(zip net_names nets)
net_map = GenericContainer $ Map.fromList
(map (\n -> (networkUuid n, n)) nets_unique)
new_cfg = old_cfg { configNetworks = net_map }
return new_cfg
-- * Test properties
-- | Tests that fillDict behaves correctly
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for Network Queries.
-}
{-
Copyright (C) 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Test.Ganeti.Query.Network
( testQuery_Network
) where
import Ganeti.JSON
import Ganeti.Objects
import Ganeti.Query.Network
import Ganeti.Types
import Test.Ganeti.Objects
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHelper
import Test.QuickCheck
import qualified Data.Map as Map
import Data.Maybe
instance Arbitrary ConfigData where
arbitrary = genEmptyCluster 0 >>= genConfigDataWithNetworks
-- | Check if looking up a valid network ID of a nodegroup yields
-- a non-Nothing result.
prop_getGroupConnection :: NodeGroup -> Property
prop_getGroupConnection group =
let net_keys = (Map.keys . fromContainer . groupNetworks) group
in True ==? all
(\nk -> isJust (getGroupConnection nk group)) net_keys
-- | Checks if looking up an ID of a non-existing network in a node group
-- yields 'Nothing'.
prop_getGroupConnection_notFound :: NodeGroup -> String -> Property
prop_getGroupConnection_notFound group uuid =
let net_keys = (Map.keys . fromContainer . groupNetworks) group
in notElem uuid net_keys ==> isNothing (getGroupConnection uuid group)
-- | Check if getting the network's UUID from the config actually gets the
-- correct UUIDs.
prop_getNetworkUuid :: ConfigData -> Property
prop_getNetworkUuid cfg =
let nets = (Map.elems . fromContainer . configNetworks) cfg
in True ==? all
(\n -> fromJust (getNetworkUuid cfg ((fromNonEmpty . networkName) n))
== networkUuid n) nets
-- | Check if trying to get a UUID of a non-existing networks results in
-- 'Nothing'.
prop_getNetworkUuid_notFound :: ConfigData -> String -> Property
prop_getNetworkUuid_notFound cfg uuid =
let net_keys = (Map.keys . fromContainer . configNetworks) cfg
in notElem uuid net_keys ==> isNothing (getNetworkUuid cfg uuid)
-- | Checks whether actually connected instances are identified as such.
prop_instIsConnected :: ConfigData -> Property
prop_instIsConnected cfg =
let nets = (fromContainer . configNetworks) cfg
net_keys = Map.keys nets
net_names = map (fromNonEmpty . networkName) (Map.elems nets)
in forAll (genInstWithNets net_names) $ \inst ->
True ==? all (\nk -> instIsConnected cfg nk inst) net_keys
-- | Tests whether instances that are not connected to a network are
-- correctly classified as such.
prop_instIsConnected_notFound :: ConfigData -> String -> Property
prop_instIsConnected_notFound cfg network_uuid =
let nets = (fromContainer . configNetworks) cfg
net_keys = Map.keys nets
net_names = map (fromNonEmpty . networkName) (Map.elems nets)
in notElem network_uuid net_keys ==>
forAll (genInstWithNets net_names) $ \inst ->
not (instIsConnected cfg network_uuid inst)
testSuite "Query_Network"
[ 'prop_getNetworkUuid
, 'prop_getNetworkUuid_notFound
, 'prop_getGroupConnection
, 'prop_getGroupConnection_notFound
, 'prop_instIsConnected
, 'prop_instIsConnected_notFound
]
......@@ -61,6 +61,7 @@ import Test.Ganeti.Objects
import Test.Ganeti.OpCodes
import Test.Ganeti.Query.Filter
import Test.Ganeti.Query.Language
import Test.Ganeti.Query.Network
import Test.Ganeti.Query.Query
import Test.Ganeti.Rpc
import Test.Ganeti.Runtime
......@@ -114,6 +115,7 @@ allTests =
, testOpCodes
, testQuery_Filter
, testQuery_Language
, testQuery_Network
, testQuery_Query
, testRpc
, testRuntime
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment