diff --git a/htest/Test/Ganeti/Network.hs b/htest/Test/Ganeti/Network.hs
index 6df8b82c2dd710593fe95dce6bf254f4b8b53510..4867830c95d90433483e542ccabcee2d08444a15 100644
--- a/htest/Test/Ganeti/Network.hs
+++ b/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))
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index 7e3e9919f44a54811cbd4ee146a5a56430ab757b..03da9e7df54041817310a3eef41262df552d5cb1 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/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
]
diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs
index 58107b2787a6eee1d200374ef970cf57bdf411fa..931b2063ea61d59021129e9a483918180c41f865 100644
--- a/htest/Test/Ganeti/OpCodes.hs
+++ b/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
diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
index 13878297740afbf91f47a5226ca21fd5035c77af..0a33931da74fd21ae0535f0917fe5cab7dba9dcf 100644
--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/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.