Split Rpc tests from QC

This required lots of other code moves, so I created it as a
standalone patch.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

Makefile.am

@@ -433,8 +433,9 @@ HS_LIB_SRCS = \
 	htools/Ganeti/THH.hs \
 	htest/Test/Ganeti/TestHelper.hs \
 	htest/Test/Ganeti/TestCommon.hs \
+	htest/Test/Ganeti/Confd/Utils.hs \
 	htest/Test/Ganeti/Objects.hs \
-	htest/Test/Ganeti/Confd/Utils.hs
+	htest/Test/Ganeti/Rpc.hs
 
 
 HS_BUILT_SRCS = htools/Ganeti/HTools/Version.hs htools/Ganeti/Constants.hs

htest/Test/Ganeti/Objects.hs

@@ -26,14 +26,34 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 -}
 
-module Test.Ganeti.Objects (testObjects) where
+module Test.Ganeti.Objects
+  ( testObjects
+  , Objects.Hypervisor(..)
+  , Objects.Node(..)
+  ) where
 
+import Control.Applicative
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import Test.QuickCheck
 
 import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon
 import qualified Ganeti.Objects as Objects
 
+instance Arbitrary Objects.Hypervisor where
+  arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Objects.PartialNDParams where
+  arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
+
+instance Arbitrary Objects.Node where
+  arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+              <*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
+              <*> (Set.fromList <$> genTags)
+
 -- | Tests that fillDict behaves correctly
 prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
 prop_Objects_fillDict defaults custom =

htest/Test/Ganeti/Rpc.hs

+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-| Unittests for ganeti-htools.
+
+-}
+
+{-
+
+Copyright (C) 2009, 2010, 2011, 2012 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.Rpc (testRpc) where
+
+import Test.QuickCheck
+import Test.QuickCheck.Monadic (monadicIO, run, stop)
+
+import Control.Applicative
+
+import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon
+import Test.Ganeti.Objects ()
+
+import qualified Ganeti.Rpc as Rpc
+import qualified Ganeti.Objects as Objects
+
+instance Arbitrary Rpc.RpcCallAllInstancesInfo where
+  arbitrary = Rpc.RpcCallAllInstancesInfo <$> arbitrary
+
+instance Arbitrary Rpc.RpcCallInstanceList where
+  arbitrary = Rpc.RpcCallInstanceList <$> arbitrary
+
+instance Arbitrary Rpc.RpcCallNodeInfo where
+  arbitrary = Rpc.RpcCallNodeInfo <$> arbitrary <*> arbitrary
+
+-- | Monadic check that, for an offline node and a call that does not
+-- offline nodes, we get a OfflineNodeError response.
+-- FIXME: We need a way of generalizing this, running it for
+-- every call manually will soon get problematic
+prop_Rpc_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
+prop_Rpc_noffl_request_allinstinfo call =
+  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
+      res <- run $ Rpc.executeRpcCall [node] call
+      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+
+prop_Rpc_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
+prop_Rpc_noffl_request_instlist call =
+  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
+      res <- run $ Rpc.executeRpcCall [node] call
+      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+
+prop_Rpc_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
+prop_Rpc_noffl_request_nodeinfo call =
+  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
+      res <- run $ Rpc.executeRpcCall [node] call
+      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+
+testSuite "Rpc"
+  [ 'prop_Rpc_noffl_request_allinstinfo
+  , 'prop_Rpc_noffl_request_instlist
+  , 'prop_Rpc_noffl_request_nodeinfo
+  ]

htest/Test/Ganeti/TestCommon.hs

@@ -108,3 +108,35 @@ getMaybe subgen = do
   if bool
     then Just <$> subgen
     else return Nothing
+
+-- | Defines a tag type.
+newtype TagChar = TagChar { tagGetChar :: Char }
+
+-- | All valid tag chars. This doesn't need to match _exactly_
+-- Ganeti's own tag regex, just enough for it to be close.
+tagChar :: [Char]
+tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
+
+instance Arbitrary TagChar where
+  arbitrary = do
+    c <- elements tagChar
+    return (TagChar c)
+
+-- | Generates a tag
+genTag :: Gen [TagChar]
+genTag = do
+  -- the correct value would be C.maxTagLen, but that's way too
+  -- verbose in unittests, and at the moment I don't see any possible
+  -- bugs with longer tags and the way we use tags in htools
+  n <- choose (1, 10)
+  vector n
+
+-- | Generates a list of tags (correctly upper bounded).
+genTags :: Gen [String]
+genTags = do
+  -- the correct value would be C.maxTagsPerObj, but per the comment
+  -- in genTag, we don't use tags enough in htools to warrant testing
+  -- such big values
+  n <- choose (0, 10::Int)
+  tags <- mapM (const genTag) [1..n]
+  return $ map (map tagGetChar) tags

htest/test.hs

@@ -32,6 +32,7 @@ import System.Environment (getArgs)
 import Ganeti.HTools.QC
 import Test.Ganeti.Confd.Utils
 import Test.Ganeti.Objects
+import Test.Ganeti.Rpc
 
 -- | Our default test options, overring the built-in test-framework
 -- ones.

htools/Ganeti/HTools/QC.hs

@@ -48,9 +48,7 @@ module Ganeti.HTools.QC
   , testJSON
   , testLuxi
   , testSsconf
-  , testRpc
   , testQlang
-  , testConfd
   ) where
 
 import qualified Test.HUnit as HUnit
@@ -87,7 +85,6 @@ import qualified Ganeti.Logging as Logging
 import qualified Ganeti.Luxi as Luxi
 import qualified Ganeti.Objects as Objects
 import qualified Ganeti.OpCodes as OpCodes
-import qualified Ganeti.Rpc as Rpc
 import qualified Ganeti.Query.Language as Qlang
 import qualified Ganeti.Runtime as Runtime
 import qualified Ganeti.Ssconf as Ssconf
@@ -281,38 +278,6 @@ getFields = do
   n <- choose (1, 32)
   vectorOf n getName
 
--- | Defines a tag type.
-newtype TagChar = TagChar { tagGetChar :: Char }
-
--- | All valid tag chars. This doesn't need to match _exactly_
--- Ganeti's own tag regex, just enough for it to be close.
-tagChar :: [Char]
-tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
-
-instance Arbitrary TagChar where
-  arbitrary = do
-    c <- elements tagChar
-    return (TagChar c)
-
--- | Generates a tag
-genTag :: Gen [TagChar]
-genTag = do
-  -- the correct value would be C.maxTagLen, but that's way too
-  -- verbose in unittests, and at the moment I don't see any possible
-  -- bugs with longer tags and the way we use tags in htools
-  n <- choose (1, 10)
-  vector n
-
--- | Generates a list of tags (correctly upper bounded).
-genTags :: Gen [String]
-genTags = do
-  -- the correct value would be C.maxTagsPerObj, but per the comment
-  -- in genTag, we don't use tags enough in htools to warrant testing
-  -- such big values
-  n <- choose (0, 10::Int)
-  tags <- mapM (const genTag) [1..n]
-  return $ map (map tagGetChar) tags
-
 instance Arbitrary Types.InstanceStatus where
     arbitrary = elements [minBound..maxBound]
 
@@ -489,28 +454,6 @@ instance Arbitrary Types.IPolicy where
                          , Types.iPolicySpindleRatio = spindle_ratio
                          }
 
-instance Arbitrary Objects.Hypervisor where
-  arbitrary = elements [minBound..maxBound]
-
-instance Arbitrary Objects.PartialNDParams where
-  arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
-
-instance Arbitrary Objects.Node where
-  arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
-              <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
-              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-              <*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
-              <*> (Set.fromList <$> genTags)
-
-instance Arbitrary Rpc.RpcCallAllInstancesInfo where
-  arbitrary = Rpc.RpcCallAllInstancesInfo <$> arbitrary
-
-instance Arbitrary Rpc.RpcCallInstanceList where
-  arbitrary = Rpc.RpcCallInstanceList <$> arbitrary
-
-instance Arbitrary Rpc.RpcCallNodeInfo where
-  arbitrary = Rpc.RpcCallNodeInfo <$> arbitrary <*> arbitrary
-
 -- | Custom 'Qlang.Filter' generator (top-level), which enforces a
 -- (sane) limit on the depth of the generated filters.
 genFilter :: Gen (Qlang.Filter Qlang.FilterField)
@@ -1976,36 +1919,6 @@ testSuite "Ssconf"
   [ 'prop_Ssconf_filename
   ]
 
--- * Rpc tests
-
--- | Monadic check that, for an offline node and a call that does not
--- offline nodes, we get a OfflineNodeError response.
--- FIXME: We need a way of generalizing this, running it for
--- every call manually will soon get problematic
-prop_Rpc_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
-prop_Rpc_noffl_request_allinstinfo call =
-  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
-      res <- run $ Rpc.executeRpcCall [node] call
-      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
-
-prop_Rpc_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
-prop_Rpc_noffl_request_instlist call =
-  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
-      res <- run $ Rpc.executeRpcCall [node] call
-      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
-
-prop_Rpc_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
-prop_Rpc_noffl_request_nodeinfo call =
-  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
-      res <- run $ Rpc.executeRpcCall [node] call
-      stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
-
-testSuite "Rpc"
-  [ 'prop_Rpc_noffl_request_allinstinfo
-  , 'prop_Rpc_noffl_request_instlist
-  , 'prop_Rpc_noffl_request_nodeinfo
-  ]
-
 -- * Qlang tests
 
 -- | Tests that serialisation/deserialisation of filters is