Haskell/python compatibility test for networks

This patch contains the HUnit test that checks the compatibility
of Haskell-generated networks with the python code. For that the
generation of test instances of networks was enhanced to meet
the validation steps of the python implementation. Also, so far
networks were generated at two different places in the code; this
is now consolidated.

Signed-off-by: Helga Velroyen <helgav@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

htest/Test/Ganeti/Network.hs

@@ -3,75 +3,34 @@
 
 module Test.Ganeti.Network
   ( testNetwork
+  , genBitStringMaxLen
+  , genNetworkType
   ) where
 
 import Test.QuickCheck
 
-import Control.Monad
-
 import Ganeti.Network as Network
 import Ganeti.Objects as Objects
-import Ganeti.Types
 
-import Test.Ganeti.Query.Language (genJSValue)
+import Test.Ganeti.Objects
+  ( genBitStringMaxLen
+  , genNetworkType
+  , genValidNetwork )
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
 
 import qualified Data.Vector.Unboxed as V
-import qualified Data.Set as S
 
 -- * Generators and arbitrary instances
 
--- | Generate an arbitrary string consisting of '0' and '1' of the given length.
-genBitString :: Int -> Gen String
-genBitString len = vectorOf len (elements "01")
-
--- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
--- length.
-genBitStringMaxLen :: Int -> Gen String
-genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
-
--- | Generates an arbitrary bit vector of the given length.
-genBitVector :: Int -> Gen (V.Vector Bool)
-genBitVector len = do
-  boolList <- vector len::Gen [Bool]
-  return $ V.fromList boolList
-
--- | Generates a network instance with bit vectors of the given lengths for
--- reservations and external reservations.
-genValidNetwork :: Int -> Gen Objects.Network
-genValidNetwork maxLenBitStr = do
-  lenBitStr <- choose (0, maxLenBitStr)
-  name <- genName >>= mkNonEmpty
-  network_type <- genMaybe genNetworkType
-  mac_prefix <- genMaybe genName
-  fam <- arbitrary
-  net <- genName >>= mkNonEmpty
-  net6 <- genMaybe genName
-  gateway <- genMaybe genName
-  gateway6 <- genMaybe genName
-  size <- genMaybe genJSValue
-  res <- liftM Just (genBitString lenBitStr)
-  ext_res <- liftM Just (genBitString lenBitStr)
-  let n = Network name network_type mac_prefix fam net net6 gateway
-          gateway6 size res ext_res 0 S.empty
-  return n
-
--- | Generates an arbitrary network type.
-genNetworkType :: Gen NetworkType
-genNetworkType = elements [ PrivateNetwork, PublicNetwork ]
-
--- | Network instances are generated arbitrarily only with short bit strings to
--- not slow down the test execution too much.
-instance Arbitrary Objects.Network where
-  arbitrary = genValidNetwork 256
-
 -- | Generates address pools. The size of the network is intentionally
 -- decoupled from the size of the bit vectors, to avoid slowing down
 -- the tests by generating unnecessary bit strings.
 genAddressPool :: Int -> Gen AddressPool
 genAddressPool maxLenBitVec = do
-  net <- arbitrary
+  -- Generating networks with netmask of minimum /24 to avoid too long
+  -- bit strings being generated.
+  net <- genValidNetwork
   lenBitVec <- choose (0, maxLenBitVec)
   res <- genBitVector lenBitVec
   ext_res <- genBitVector lenBitVec
@@ -79,6 +38,12 @@ genAddressPool maxLenBitVec = do
                      , reservations = res
                      , extReservations = ext_res }
 
+-- | Generates an arbitrary bit vector of the given length.
+genBitVector :: Int -> Gen (V.Vector Bool)
+genBitVector len = do
+  boolList <- vector len::Gen [Bool]
+  return $ V.fromList boolList
+
 instance Arbitrary AddressPool where
   arbitrary = genAddressPool ((2::Int)^(8::Int))
 

htest/Test/Ganeti/Objects.hs

@@ -30,13 +30,20 @@ module Test.Ganeti.Objects
   ( testObjects
   , Node(..)
   , genEmptyCluster
+  , genValidNetwork
+  , genNetworkType
+  , genBitStringMaxLen
   ) where
 
 import Test.QuickCheck
+import qualified Test.HUnit as HUnit
 
 import Control.Applicative
+import Control.Monad
+import Data.Char
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Text.JSON as J
 
 import Test.Ganeti.Query.Language (genJSValue)
 import Test.Ganeti.TestHelper
@@ -44,8 +51,10 @@ import Test.Ganeti.TestCommon
 import Test.Ganeti.Types ()
 
 import qualified Ganeti.Constants as C
+import Ganeti.Network
 import Ganeti.Objects as Objects
 import Ganeti.JSON
+import Ganeti.Types
 
 {-# ANN module "HLint: ignore Use camelCase" #-}
 
@@ -164,33 +173,42 @@ instance Arbitrary TagSet where
 $(genArbitrary ''Cluster)
 
 instance Arbitrary Network where
-  arbitrary = Network <$>
-                        -- name
-                        arbitrary
-                        -- network_type
-                        <*> arbitrary
-                        -- mac_prefix
-                        <*> arbitrary
-                        -- family
-                        <*> arbitrary
-                        -- network
-                        <*> arbitrary
-                        -- network6
-                        <*> arbitrary
-                        -- gateway
-                        <*> arbitrary
-                        -- gateway6
-                        <*> arbitrary
-                        -- size
-                        <*> genMaybe genJSValue
-                        -- reservations
-                        <*> arbitrary
-                        -- external reservations
-                        <*> arbitrary
-                        -- serial
-                        <*> arbitrary
-                        -- tags
-                        <*> (Set.fromList <$> genTags)
+  arbitrary = genValidNetwork
+
+-- | Generates a network instance with minimum netmasks of /24. Generating
+-- bigger networks slows down the tests, because long bit strings are generated
+-- for the reservations.
+genValidNetwork :: Gen Objects.Network
+genValidNetwork = do
+  -- generate netmask for the IPv4 network
+  netmask <- choose (24::Int, 30)
+  name <- genName >>= mkNonEmpty
+  network_type <- genMaybe genNetworkType
+  mac_prefix <- genMaybe genName
+  fam <- arbitrary
+  net <- genIp4NetWithNetmask netmask
+  net6 <- genMaybe genIp6Net
+  gateway <- genMaybe genIp4AddrStr
+  gateway6 <- genMaybe genIp6Addr
+  size <- genMaybe genJSValue
+  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
+  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
+  let n = Network name network_type mac_prefix fam net net6 gateway
+          gateway6 size res ext_res 0 Set.empty
+  return n
+
+-- | Generates an arbitrary network type.
+genNetworkType :: Gen NetworkType
+genNetworkType = elements [ PrivateNetwork, PublicNetwork ]
+
+-- | Generate an arbitrary string consisting of '0' and '1' of the given length.
+genBitString :: Int -> Gen String
+genBitString len = vectorOf len (elements "01")
+
+-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
+-- length.
+genBitStringMaxLen :: Int -> Gen String
+genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
 
 -- | Generator for config data with an empty cluster (no instances),
 -- with N defined nodes.
@@ -261,6 +279,58 @@ prop_Config_serialisation :: Property
 prop_Config_serialisation =
   forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
 
+-- | Custom HUnit test to check the correspondence between Haskell-generated
+-- networks and their Python decoded, validated and re-encoded version.
+-- For the technical background of this unit test, check the documentation
+-- of "case_py_compat_types" of htest/Test/Ganeti/Opcodes.hs
+case_py_compat_networks :: HUnit.Assertion
+case_py_compat_networks = do
+  let num_networks = 500::Int
+  sample_networks <- sample' (vectorOf num_networks genValidNetwork)
+  let networks = head sample_networks
+      networks_with_properties = map getNetworkProperties networks
+      serialized = J.encode networks
+  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
+  mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
+                 HUnit.assertFailure $
+                 "Network has non-ASCII fields: " ++ show net
+        ) networks
+  py_stdout <-
+    runPython "from ganeti import network\n\
+              \from ganeti import objects\n\
+              \from ganeti import serializer\n\
+              \import sys\n\
+              \net_data = serializer.Load(sys.stdin.read())\n\
+              \decoded = [objects.Network.FromDict(n) for n in net_data]\n\
+              \encoded = []\n\
+              \for net in decoded:\n\
+              \  a = network.AddressPool(net)\n\
+              \  encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\
+              \    net.ToDict()))\n\
+              \print serializer.Dump(encoded)" serialized
+    >>= checkPythonResult
+  let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)]
+  decoded <- case deserialised of
+               J.Ok ops -> return ops
+               J.Error msg ->
+                 HUnit.assertFailure ("Unable to decode networks: " ++ msg)
+                 -- this already raised an expection, but we need it
+                 -- for proper types
+                 >> fail "Unable to decode networks"
+  HUnit.assertEqual "Mismatch in number of returned networks"
+    (length decoded) (length networks_with_properties)
+  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
+        ) $ zip decoded networks_with_properties
+
+-- | Creates a tuple of the given network combined with some of its properties
+-- to be compared against the same properties generated by the python code.
+getNetworkProperties :: Network -> (Int, Int, Network)
+getNetworkProperties net =
+  let maybePool = createAddressPool net
+  in  case maybePool of
+           (Just pool) -> (getFreeCount pool, getReservedCount pool, net)
+           Nothing -> (-1, -1, net)
+
 testSuite "Objects"
   [ 'prop_fillDict
   , 'prop_Disk_serialisation
@@ -268,4 +338,5 @@ testSuite "Objects"
   , 'prop_Network_serialisation
   , 'prop_Node_serialisation
   , 'prop_Config_serialisation
+  , 'case_py_compat_networks
   ]

htest/Test/Ganeti/OpCodes.hs

@@ -386,22 +386,6 @@ genNamesNE = resize maxNodes (listOf genNameNE)
 genFieldsNE :: Gen [NonEmptyString]
 genFieldsNE = genFields >>= mapM mkNonEmpty
 
--- | Generate an arbitrary IPv4 address in textual form.
-genIp4Addr :: Gen NonEmptyString
-genIp4Addr = do
-  a <- choose (1::Int, 255)
-  b <- choose (0::Int, 255)
-  c <- choose (0::Int, 255)
-  d <- choose (0::Int, 255)
-  mkNonEmpty $ intercalate "." (map show [a, b, c, d])
-
--- | Generate an arbitrary IPv4 network address in textual form.
-genIp4Net :: Gen NonEmptyString
-genIp4Net = do
-  netmask <- choose (8::Int, 30)
-  ip <- genIp4Addr
-  mkNonEmpty $ fromNonEmpty ip ++ "/" ++ show netmask
-
 -- | Generate a 3-byte MAC prefix.
 genMacPrefix :: Gen NonEmptyString
 genMacPrefix = do

htest/Test/Ganeti/TestCommon.hs

@@ -38,8 +38,10 @@ import qualified Test.HUnit as HUnit
 import Test.QuickCheck
 import Test.QuickCheck.Monadic
 import qualified Text.JSON as J
+import Numeric
 
 import qualified Ganeti.BasicTypes as BasicTypes
+import Ganeti.Types
 
 -- * Constants
 
@@ -215,6 +217,52 @@ genSetHelper candidates size = do
 genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
 genSet = genSetHelper [minBound..maxBound]
 
+-- | Generate an arbitrary IPv4 address in textual form (non empty).
+genIp4Addr :: Gen NonEmptyString
+genIp4Addr = genIp4AddrStr >>= mkNonEmpty
+
+-- | Generate an arbitrary IPv4 address in textual form.
+genIp4AddrStr :: Gen String
+genIp4AddrStr = do
+  a <- choose (1::Int, 255)
+  b <- choose (0::Int, 255)
+  c <- choose (0::Int, 255)
+  d <- choose (0::Int, 255)
+  return $ intercalate "." (map show [a, b, c, d])
+
+-- | Generates an arbitrary IPv4 address with a given netmask in textual form.
+genIp4NetWithNetmask :: Int -> Gen NonEmptyString
+genIp4NetWithNetmask netmask = do
+  ip <- genIp4AddrStr
+  mkNonEmpty $ ip ++ "/" ++ show netmask
+
+-- | Generate an arbitrary IPv4 network in textual form.
+genIp4Net :: Gen NonEmptyString
+genIp4Net = do
+  netmask <- choose (8::Int, 30)
+  genIp4NetWithNetmask netmask
+
+-- | Helper function to compute the number of hosts in a network
+-- given the netmask. (For IPv4 only.)
+netmask2NumHosts :: Int -> Int
+netmask2NumHosts n = (2::Int)^((32::Int)-n)
+
+-- | Generates an arbitrary IPv6 network address in textual form.
+-- The generated address is not simpflified, e. g. an address like
+-- "2607:f0d0:1002:0051:0000:0000:0000:0004" does not become
+-- "2607:f0d0:1002:51::4"
+genIp6Addr :: Gen String
+genIp6Addr = do
+  rawIp <- vectorOf 8 $ choose (0::Integer, 65535)
+  return $ intercalate ":" (map (`showHex` "") rawIp)
+
+-- | Generates an arbitrary IPv6 network in textual form.
+genIp6Net :: Gen String
+genIp6Net = do
+  netmask <- choose (8::Int, 126)
+  ip <- genIp6Addr
+  return $ ip ++ "/" ++ show netmask
+
 -- * Helper functions
 
 -- | Checks for serialisation idempotence.