Revision 0b288282 htest/Test/Ganeti/Objects.hs

b/htest/Test/Ganeti/Objects.hs
30 30
  ( testObjects
31 31
  , Node(..)
32 32
  , genEmptyCluster
33
  , genValidNetwork
34
  , genNetworkType
35
  , genBitStringMaxLen
33 36
  ) where
34 37

  
35 38
import Test.QuickCheck
39
import qualified Test.HUnit as HUnit
36 40

  
37 41
import Control.Applicative
42
import Control.Monad
43
import Data.Char
38 44
import qualified Data.Map as Map
39 45
import qualified Data.Set as Set
46
import qualified Text.JSON as J
40 47

  
41 48
import Test.Ganeti.Query.Language (genJSValue)
42 49
import Test.Ganeti.TestHelper
......
44 51
import Test.Ganeti.Types ()
45 52

  
46 53
import qualified Ganeti.Constants as C
54
import Ganeti.Network
47 55
import Ganeti.Objects as Objects
48 56
import Ganeti.JSON
57
import Ganeti.Types
49 58

  
50 59
{-# ANN module "HLint: ignore Use camelCase" #-}
51 60

  
......
164 173
$(genArbitrary ''Cluster)
165 174

  
166 175
instance Arbitrary Network where
167
  arbitrary = Network <$>
168
                        -- name
169
                        arbitrary
170
                        -- network_type
171
                        <*> arbitrary
172
                        -- mac_prefix
173
                        <*> arbitrary
174
                        -- family
175
                        <*> arbitrary
176
                        -- network
177
                        <*> arbitrary
178
                        -- network6
179
                        <*> arbitrary
180
                        -- gateway
181
                        <*> arbitrary
182
                        -- gateway6
183
                        <*> arbitrary
184
                        -- size
185
                        <*> genMaybe genJSValue
186
                        -- reservations
187
                        <*> arbitrary
188
                        -- external reservations
189
                        <*> arbitrary
190
                        -- serial
191
                        <*> arbitrary
192
                        -- tags
193
                        <*> (Set.fromList <$> genTags)
176
  arbitrary = genValidNetwork
177

  
178
-- | Generates a network instance with minimum netmasks of /24. Generating
179
-- bigger networks slows down the tests, because long bit strings are generated
180
-- for the reservations.
181
genValidNetwork :: Gen Objects.Network
182
genValidNetwork = do
183
  -- generate netmask for the IPv4 network
184
  netmask <- choose (24::Int, 30)
185
  name <- genName >>= mkNonEmpty
186
  network_type <- genMaybe genNetworkType
187
  mac_prefix <- genMaybe genName
188
  fam <- arbitrary
189
  net <- genIp4NetWithNetmask netmask
190
  net6 <- genMaybe genIp6Net
191
  gateway <- genMaybe genIp4AddrStr
192
  gateway6 <- genMaybe genIp6Addr
193
  size <- genMaybe genJSValue
194
  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
195
  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
196
  let n = Network name network_type mac_prefix fam net net6 gateway
197
          gateway6 size res ext_res 0 Set.empty
198
  return n
199

  
200
-- | Generates an arbitrary network type.
201
genNetworkType :: Gen NetworkType
202
genNetworkType = elements [ PrivateNetwork, PublicNetwork ]
203

  
204
-- | Generate an arbitrary string consisting of '0' and '1' of the given length.
205
genBitString :: Int -> Gen String
206
genBitString len = vectorOf len (elements "01")
207

  
208
-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
209
-- length.
210
genBitStringMaxLen :: Int -> Gen String
211
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
194 212

  
195 213
-- | Generator for config data with an empty cluster (no instances),
196 214
-- with N defined nodes.
......
261 279
prop_Config_serialisation =
262 280
  forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
263 281

  
282
-- | Custom HUnit test to check the correspondence between Haskell-generated
283
-- networks and their Python decoded, validated and re-encoded version.
284
-- For the technical background of this unit test, check the documentation
285
-- of "case_py_compat_types" of htest/Test/Ganeti/Opcodes.hs
286
case_py_compat_networks :: HUnit.Assertion
287
case_py_compat_networks = do
288
  let num_networks = 500::Int
289
  sample_networks <- sample' (vectorOf num_networks genValidNetwork)
290
  let networks = head sample_networks
291
      networks_with_properties = map getNetworkProperties networks
292
      serialized = J.encode networks
293
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
294
  mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
295
                 HUnit.assertFailure $
296
                 "Network has non-ASCII fields: " ++ show net
297
        ) networks
298
  py_stdout <-
299
    runPython "from ganeti import network\n\
300
              \from ganeti import objects\n\
301
              \from ganeti import serializer\n\
302
              \import sys\n\
303
              \net_data = serializer.Load(sys.stdin.read())\n\
304
              \decoded = [objects.Network.FromDict(n) for n in net_data]\n\
305
              \encoded = []\n\
306
              \for net in decoded:\n\
307
              \  a = network.AddressPool(net)\n\
308
              \  encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\
309
              \    net.ToDict()))\n\
310
              \print serializer.Dump(encoded)" serialized
311
    >>= checkPythonResult
312
  let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)]
313
  decoded <- case deserialised of
314
               J.Ok ops -> return ops
315
               J.Error msg ->
316
                 HUnit.assertFailure ("Unable to decode networks: " ++ msg)
317
                 -- this already raised an expection, but we need it
318
                 -- for proper types
319
                 >> fail "Unable to decode networks"
320
  HUnit.assertEqual "Mismatch in number of returned networks"
321
    (length decoded) (length networks_with_properties)
322
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
323
        ) $ zip decoded networks_with_properties
324

  
325
-- | Creates a tuple of the given network combined with some of its properties
326
-- to be compared against the same properties generated by the python code.
327
getNetworkProperties :: Network -> (Int, Int, Network)
328
getNetworkProperties net =
329
  let maybePool = createAddressPool net
330
  in  case maybePool of
331
           (Just pool) -> (getFreeCount pool, getReservedCount pool, net)
332
           Nothing -> (-1, -1, net)
333

  
264 334
testSuite "Objects"
265 335
  [ 'prop_fillDict
266 336
  , 'prop_Disk_serialisation
......
268 338
  , 'prop_Network_serialisation
269 339
  , 'prop_Node_serialisation
270 340
  , 'prop_Config_serialisation
341
  , 'case_py_compat_networks
271 342
  ]

Also available in: Unified diff