Simple QC tests for RPC calls

Right now we're only able to test if when a node is offline, the call
fails with an appropriate errror.
Signed-off-by: Agata Murawska <agatamurawska@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>

htools/Ganeti/HTools/QC.hs

@@ -48,10 +48,11 @@ module Ganeti.HTools.QC
   , testJSON
   , testLUXI
   , testSsconf
+  , testRpc
   ) where
 
 import Test.QuickCheck
-import Test.QuickCheck.Monadic (assert, monadicIO, run)
+import Test.QuickCheck.Monadic (assert, monadicIO, run, stop)
 import Text.Printf (printf)
 import Data.List (intercalate, nub, isPrefixOf)
 import Data.Maybe
@@ -535,6 +536,24 @@ instance Arbitrary Types.IPolicy where
                          , Types.iPolicySpindleRatio = spindle_ratio
                          }
 
+instance Arbitrary Objects.Hypervisor where
+  arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Objects.Node where
+  arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+              <*> arbitrary <*> getFQDN  <*> arbitrary
+
+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
+
 -- * Actual tests
 
 -- ** Utils tests
@@ -1902,3 +1921,33 @@ prop_Ssconf_filename key =
 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
+  ]

htools/test.hs

@@ -127,6 +127,7 @@ allTests =
   , (fast, testLUXI)
   , (fast, testSsconf)
   , (slow, testCluster)
+  , (fast, testRpc)
   ]
 
 -- | Extracts the name of a test group.