From 834bea99eeebca50477217297a385a212a802ba1 Mon Sep 17 00:00:00 2001
From: Helga Velroyen <helgav@google.com>
Date: Thu, 7 Feb 2013 18:30:04 +0100
Subject: [PATCH] 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: Helga Velroyen <helgav@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
Makefile.am | 1 +
src/Ganeti/Query/Network.hs | 11 ++-
test/hs/Test/Ganeti/Objects.hs | 37 +++++++++
test/hs/Test/Ganeti/Query/Network.hs | 110 +++++++++++++++++++++++++++
test/hs/htest.hs | 2 +
5 files changed, 158 insertions(+), 3 deletions(-)
create mode 100644 test/hs/Test/Ganeti/Query/Network.hs
diff --git a/Makefile.am b/Makefile.am
index 60118fe31..7425e2221 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs
index 2d262bfa0..a9c46c7d5 100644
--- a/src/Ganeti/Query/Network.hs
+++ b/src/Ganeti/Query/Network.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.
diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs
index dc619eccf..e1752ee56 100644
--- a/test/hs/Test/Ganeti/Objects.hs
+++ b/test/hs/Test/Ganeti/Objects.hs
@@ -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
diff --git a/test/hs/Test/Ganeti/Query/Network.hs b/test/hs/Test/Ganeti/Query/Network.hs
new file mode 100644
index 000000000..4a3ae50bb
--- /dev/null
+++ b/test/hs/Test/Ganeti/Query/Network.hs
@@ -0,0 +1,110 @@
+{-# 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
+ ]
+
+
diff --git a/test/hs/htest.hs b/test/hs/htest.hs
index 4358c8589..b93ba81e2 100644
--- a/test/hs/htest.hs
+++ b/test/hs/htest.hs
@@ -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
--
GitLab