Revision 8d239fa4

b/htest/Test/Ganeti/OpCodes.hs
38 38
import Data.List
39 39
import qualified Data.Map as Map
40 40
import qualified Text.JSON as J
41
import Text.Printf (printf)
41 42

  
42 43
import Test.Ganeti.TestHelper
43 44
import Test.Ganeti.TestCommon
......
308 309
      "OP_TEST_DUMMY" ->
309 310
        OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
310 311
          pure J.JSNull <*> pure J.JSNull
312
      "OP_NETWORK_ADD" ->
313
        OpCodes.OpNetworkAdd <$> genNameNE <*> arbitrary <*> genIp4Net <*>
314
          getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
315
          getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*>
316
          (genTags >>= mapM mkNonEmpty)
317
      "OP_NETWORK_REMOVE" ->
318
        OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary
319
      "OP_NETWORK_SET_PARAMS" ->
320
        OpCodes.OpNetworkSetParams <$> genNameNE <*> arbitrary <*>
321
          getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
322
          getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*>
323
          getMaybe (listOf genIp4Addr)
324
      "OP_NETWORK_CONNECT" ->
325
        OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*>
326
          arbitrary <*> genNameNE <*> arbitrary
327
      "OP_NETWORK_DISCONNECT" ->
328
        OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE <*> arbitrary
329
      "OP_NETWORK_QUERY" ->
330
        OpCodes.OpNetworkQuery <$> genFieldsNE <*> genNamesNE
311 331
      _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
312 332

  
313 333
-- * Helper functions
......
354 374
genFieldsNE :: Gen [NonEmptyString]
355 375
genFieldsNE = getFields >>= mapM mkNonEmpty
356 376

  
377
-- | Generate an arbitrary IPv4 address in textual form.
378
genIp4Addr :: Gen NonEmptyString
379
genIp4Addr = do
380
  a <- choose (1::Int, 255)
381
  b <- choose (0::Int, 255)
382
  c <- choose (0::Int, 255)
383
  d <- choose (0::Int, 255)
384
  mkNonEmpty $ intercalate "." (map show [a, b, c, d])
385

  
386
-- | Generate an arbitrary IPv4 network address in textual form.
387
genIp4Net :: Gen NonEmptyString
388
genIp4Net = do
389
  netmask <- choose (8::Int, 30)
390
  ip <- genIp4Addr
391
  mkNonEmpty $ fromNonEmpty ip ++ "/" ++ show netmask
392

  
393
-- | Generate a 3-byte MAC prefix.
394
genMacPrefix :: Gen NonEmptyString
395
genMacPrefix = do
396
  octets <- vectorOf 3 $ choose (0::Int, 255)
397
  mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
398

  
357 399
-- * Test cases
358 400

  
359 401
-- | Check that opcode serialization is idempotent.
b/htest/Test/Ganeti/Types.hs
103 103

  
104 104
$(genArbitrary ''IAllocatorMode)
105 105

  
106
$(genArbitrary ''NetworkType)
107

  
106 108
$(genArbitrary ''NICMode)
107 109

  
108 110
-- * Properties
......
233 235
      all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound]
234 236
  assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes
235 237

  
238
-- | Test 'NetworkType' serialisation.
239
prop_NetworkType_serialisation :: NetworkType -> Property
240
prop_NetworkType_serialisation = testSerialisation
241

  
242
-- | Tests equivalence with Python, based on Constants.hs code.
243
case_NetworkType_pyequiv :: Assertion
244
case_NetworkType_pyequiv = do
245
  let all_py_codes = sort C.networkValidTypes
246
      all_hs_codes = sort $ map Types.networkTypeToRaw [minBound..maxBound]
247
  assertEqual "for NetworkType equivalence" all_py_codes all_hs_codes
248

  
236 249
-- | Test 'NICMode' serialisation.
237 250
prop_NICMode_serialisation :: NICMode -> Property
238 251
prop_NICMode_serialisation = testSerialisation
......
271 284
  , 'prop_IAllocatorTestDir_serialisation
272 285
  , 'prop_IAllocatorMode_serialisation
273 286
  , 'case_IAllocatorMode_pyequiv
287
  , 'prop_NetworkType_serialisation
288
  , 'case_NetworkType_pyequiv
274 289
  , 'prop_NICMode_serialisation
275 290
  , 'case_NICMode_pyequiv
276 291
  ]
b/htools/Ganeti/OpCodes.hs
476 476
     , pTestDummyFail
477 477
     , pTestDummySubmitJobs
478 478
     ])
479
  , ("OpNetworkAdd",
480
     [ pNetworkName
481
     , pNetworkType
482
     , pNetworkAddress4
483
     , pNetworkGateway4
484
     , pNetworkAddress6
485
     , pNetworkGateway6
486
     , pNetworkMacPrefix
487
     , pNetworkAddRsvdIps
488
     , pInstTags
489
     ])
490
  , ("OpNetworkRemove",
491
     [ pNetworkName
492
     , pForce
493
     ])
494
  , ("OpNetworkSetParams",
495
     [ pNetworkName
496
     , pNetworkType
497
     , pNetworkGateway4
498
     , pNetworkAddress6
499
     , pNetworkGateway6
500
     , pNetworkMacPrefix
501
     , pNetworkAddRsvdIps
502
     , pNetworkRemoveRsvdIps
503
     ])
504
  , ("OpNetworkConnect",
505
     [ pGroupName
506
     , pNetworkName
507
     , pNetworkMode
508
     , pNetworkLink
509
     , pIpConflictsCheck
510
     ])
511
  , ("OpNetworkDisconnect",
512
     [ pGroupName
513
     , pNetworkName
514
     , pIpConflictsCheck
515
     ])
516
  , ("OpNetworkQuery",
517
     [ pOutputFields
518
     , pNames
519
     ])
479 520
  ])
480 521

  
481 522
-- | Returns the OP_ID for a given opcode value.
b/htools/Ganeti/OpParams.hs
209 209
  , pTestDummyMessages
210 210
  , pTestDummyFail
211 211
  , pTestDummySubmitJobs
212
  , pNetworkName
213
  , pNetworkType
214
  , pNetworkAddress4
215
  , pNetworkGateway4
216
  , pNetworkAddress6
217
  , pNetworkGateway6
218
  , pNetworkMacPrefix
219
  , pNetworkAddRsvdIps
220
  , pNetworkRemoveRsvdIps
221
  , pNetworkMode
222
  , pNetworkLink
212 223
  ) where
213 224

  
214 225
import Control.Monad (liftM)
......
1262 1273
pTestDummySubmitJobs =
1263 1274
  renameField "TestDummySubmitJobs" $
1264 1275
  simpleField "submit_jobs" [t| UncheckedValue |]
1276

  
1277
-- * Network parameters
1278

  
1279
-- | Network name.
1280
pNetworkName :: Field
1281
pNetworkName = simpleField "network_name" [t| NonEmptyString |]
1282

  
1283
-- | Network type field.
1284
pNetworkType :: Field
1285
pNetworkType = optionalField $ simpleField "network_type" [t| NetworkType |]
1286

  
1287
-- | Network address (IPv4 subnet). FIXME: no real type for this.
1288
pNetworkAddress4 :: Field
1289
pNetworkAddress4 =
1290
  renameField "NetworkAddress4" $
1291
  simpleField "network" [t| NonEmptyString |]
1292

  
1293
-- | Network gateway (IPv4 address). FIXME: no real type for this.
1294
pNetworkGateway4 :: Field
1295
pNetworkGateway4 =
1296
  renameField "NetworkGateway4" $
1297
  optionalNEStringField "gateway"
1298

  
1299
-- | Network address (IPv6 subnet). FIXME: no real type for this.
1300
pNetworkAddress6 :: Field
1301
pNetworkAddress6 =
1302
  renameField "NetworkAddress6" $
1303
  optionalNEStringField "network6"
1304

  
1305
-- | Network gateway (IPv6 address). FIXME: no real type for this.
1306
pNetworkGateway6 :: Field
1307
pNetworkGateway6 =
1308
  renameField "NetworkGateway6" $
1309
  optionalNEStringField "gateway6"
1310

  
1311
-- | Network specific mac prefix (that overrides the cluster one).
1312
pNetworkMacPrefix :: Field
1313
pNetworkMacPrefix =
1314
  renameField "NetMacPrefix" $
1315
  optionalNEStringField "mac_prefix"
1316

  
1317
-- | Network add reserved IPs.
1318
pNetworkAddRsvdIps :: Field
1319
pNetworkAddRsvdIps =
1320
  renameField "NetworkAddRsvdIps" .
1321
  optionalField $
1322
  simpleField "add_reserved_ips" [t| [NonEmptyString] |]
1323

  
1324
-- | Network remove reserved IPs.
1325
pNetworkRemoveRsvdIps :: Field
1326
pNetworkRemoveRsvdIps =
1327
  renameField "NetworkRemoveRsvdIps" .
1328
  optionalField $
1329
  simpleField "remove_reserved_ips" [t| [NonEmptyString] |]
1330

  
1331
-- | Network mode when connecting to a group.
1332
pNetworkMode :: Field
1333
pNetworkMode = simpleField "network_mode" [t| NICMode |]
1334

  
1335
-- | Network link when connecting to a group.
1336
pNetworkLink :: Field
1337
pNetworkLink = simpleField "network_link" [t| NonEmptyString |]
b/htools/Ganeti/Types.hs
67 67
  , IAllocatorTestDir(..)
68 68
  , IAllocatorMode(..)
69 69
  , iAllocatorModeToRaw
70
  , NetworkType(..)
71
  , networkTypeToRaw
70 72
  , NICMode(..)
71 73
  , nICModeToRaw
72 74
  ) where
......
317 319
  ])
318 320
$(THH.makeJSONInstance ''IAllocatorMode)
319 321

  
322
-- | Network type.
323
$(THH.declareSADT "NetworkType"
324
  [ ("PrivateNetwork", 'C.networkTypePrivate)
325
  , ("PublicNetwork",  'C.networkTypePublic)
326
  ])
327
$(THH.makeJSONInstance ''NetworkType)
328

  
320 329
-- | Netork mode.
321 330
$(THH.declareSADT "NICMode"
322 331
  [ ("NMBridged", 'C.nicModeBridged)

Also available in: Unified diff