Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / OpCodes.hs @ 9b773665

History | View | Annotate | Download (19.4 kB)

1
{-# LANGUAGE TemplateHaskell #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Test.Ganeti.OpCodes
30
  ( testOpCodes
31
  , OpCodes.OpCode(..)
32
  ) where
33

    
34
import qualified Test.HUnit as HUnit
35
import Test.QuickCheck
36

    
37
import Control.Applicative
38
import Data.List
39
import qualified Data.Map as Map
40
import qualified Text.JSON as J
41
import Text.Printf (printf)
42

    
43
import Test.Ganeti.TestHelper
44
import Test.Ganeti.TestCommon
45
import Test.Ganeti.Types ()
46
import Test.Ganeti.Query.Language
47

    
48
import qualified Ganeti.Constants as C
49
import qualified Ganeti.OpCodes as OpCodes
50
import Ganeti.Types
51
import Ganeti.OpParams
52
import Ganeti.JSON
53

    
54
{-# ANN module "HLint: ignore Use camelCase" #-}
55

    
56
-- * Arbitrary instances
57

    
58
instance Arbitrary OpCodes.TagObject where
59
  arbitrary = oneof [ OpCodes.TagInstance <$> getFQDN
60
                    , OpCodes.TagNode     <$> getFQDN
61
                    , OpCodes.TagGroup    <$> getFQDN
62
                    , pure OpCodes.TagCluster
63
                    ]
64

    
65
$(genArbitrary ''OpCodes.ReplaceDisksMode)
66

    
67
$(genArbitrary ''DiskAccess)
68

    
69
instance Arbitrary OpCodes.DiskIndex where
70
  arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
71

    
72
instance Arbitrary INicParams where
73
  arbitrary = INicParams <$> getMaybe genNameNE <*> getMaybe getName <*>
74
              getMaybe genNameNE <*> getMaybe genNameNE
75

    
76
instance Arbitrary IDiskParams where
77
  arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
78
              getMaybe genNameNE <*> getMaybe genNameNE <*>
79
              getMaybe genNameNE
80

    
81
instance Arbitrary RecreateDisksInfo where
82
  arbitrary = oneof [ pure RecreateDisksAll
83
                    , RecreateDisksIndices <$> arbitrary
84
                    , RecreateDisksParams <$> arbitrary
85
                    ]
86

    
87
instance Arbitrary DdmOldChanges where
88
  arbitrary = oneof [ DdmOldIndex <$> arbitrary
89
                    , DdmOldMod   <$> arbitrary
90
                    ]
91

    
92
instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
93
  arbitrary = oneof [ pure SetParamsEmpty
94
                    , SetParamsDeprecated <$> arbitrary
95
                    , SetParamsNew        <$> arbitrary
96
                    ]
97

    
98
instance Arbitrary ExportTarget where
99
  arbitrary = oneof [ ExportTargetLocal <$> genNodeNameNE
100
                    , ExportTargetRemote <$> pure []
101
                    ]
102

    
103
instance Arbitrary OpCodes.OpCode where
104
  arbitrary = do
105
    op_id <- elements OpCodes.allOpIDs
106
    case op_id of
107
      "OP_TEST_DELAY" ->
108
        OpCodes.OpTestDelay <$> arbitrary <*> arbitrary
109
                 <*> genNodeNames <*> arbitrary
110
      "OP_INSTANCE_REPLACE_DISKS" ->
111
        OpCodes.OpInstanceReplaceDisks <$> getFQDN <*>
112
          getMaybe genNodeNameNE <*> arbitrary <*> genDiskIndices <*>
113
          getMaybe genNameNE
114
      "OP_INSTANCE_FAILOVER" ->
115
        OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*>
116
          getMaybe genNodeNameNE
117
      "OP_INSTANCE_MIGRATE" ->
118
        OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*>
119
          arbitrary <*> arbitrary <*> getMaybe genNodeNameNE
120
      "OP_TAGS_GET" ->
121
        OpCodes.OpTagsGet <$> arbitrary <*> arbitrary
122
      "OP_TAGS_SEARCH" ->
123
        OpCodes.OpTagsSearch <$> genNameNE
124
      "OP_TAGS_SET" ->
125
        OpCodes.OpTagsSet <$> arbitrary <*> genTags
126
      "OP_TAGS_DEL" ->
127
        OpCodes.OpTagsSet <$> arbitrary <*> genTags
128
      "OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit
129
      "OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy
130
      "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
131
      "OP_CLUSTER_VERIFY" ->
132
        OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
133
          genSet Nothing <*> genSet Nothing <*> arbitrary <*>
134
          getMaybe genNameNE
135
      "OP_CLUSTER_VERIFY_CONFIG" ->
136
        OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
137
          genSet Nothing <*> arbitrary
138
      "OP_CLUSTER_VERIFY_GROUP" ->
139
        OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
140
          arbitrary <*> genSet Nothing <*> genSet Nothing <*> arbitrary
141
      "OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
142
      "OP_GROUP_VERIFY_DISKS" ->
143
        OpCodes.OpGroupVerifyDisks <$> genNameNE
144
      "OP_CLUSTER_REPAIR_DISK_SIZES" ->
145
        OpCodes.OpClusterRepairDiskSizes <$>
146
          resize maxNodes (listOf (getFQDN >>= mkNonEmpty))
147
      "OP_CLUSTER_CONFIG_QUERY" ->
148
        OpCodes.OpClusterConfigQuery <$> genFieldsNE
149
      "OP_CLUSTER_RENAME" ->
150
        OpCodes.OpClusterRename <$> (getName >>= mkNonEmpty)
151
      "OP_CLUSTER_SET_PARAMS" ->
152
        OpCodes.OpClusterSetParams <$> emptyMUD <*> emptyMUD <*>
153
          arbitrary <*> getMaybe (listOf1 arbitrary >>= mkNonEmpty) <*>
154
          getMaybe genEmptyContainer <*> emptyMUD <*>
155
          getMaybe genEmptyContainer <*> getMaybe genEmptyContainer <*>
156
          getMaybe genEmptyContainer <*> getMaybe arbitrary <*>
157
          arbitrary <*> arbitrary <*> arbitrary <*>
158
          arbitrary <*> arbitrary <*> arbitrary <*>
159
          emptyMUD <*> emptyMUD <*> arbitrary <*>
160
          arbitrary <*> arbitrary <*> arbitrary <*>
161
          arbitrary <*> arbitrary <*> arbitrary
162
      "OP_CLUSTER_REDIST_CONF" -> pure OpCodes.OpClusterRedistConf
163
      "OP_CLUSTER_ACTIVATE_MASTER_IP" ->
164
        pure OpCodes.OpClusterActivateMasterIp
165
      "OP_CLUSTER_DEACTIVATE_MASTER_IP" ->
166
        pure OpCodes.OpClusterDeactivateMasterIp
167
      "OP_QUERY" ->
168
        OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*> genFilter
169
      "OP_QUERY_FIELDS" ->
170
        OpCodes.OpQueryFields <$> arbitrary <*> arbitrary
171
      "OP_OOB_COMMAND" ->
172
        OpCodes.OpOobCommand <$> genNodeNamesNE <*> arbitrary <*>
173
          arbitrary <*> arbitrary <*> (arbitrary `suchThat` (>0))
174
      "OP_NODE_REMOVE" -> OpCodes.OpNodeRemove <$> (getFQDN >>= mkNonEmpty)
175
      "OP_NODE_ADD" ->
176
        OpCodes.OpNodeAdd <$> genNodeNameNE <*> emptyMUD <*> emptyMUD <*>
177
          getMaybe getName <*> getMaybe genNameNE <*> arbitrary <*>
178
          getMaybe genNameNE <*> arbitrary <*> arbitrary <*> emptyMUD
179
      "OP_NODE_QUERY" ->
180
        OpCodes.OpNodeQuery <$> genFieldsNE <*> arbitrary <*> genNamesNE
181
      "OP_NODE_QUERYVOLS" ->
182
        OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE
183
      "OP_NODE_QUERY_STORAGE" ->
184
        OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*>
185
          genNodeNamesNE <*> genNameNE
186
      "OP_NODE_MODIFY_STORAGE" ->
187
        OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> arbitrary <*>
188
          genNameNE <*> pure emptyJSObject
189
      "OP_REPAIR_NODE_STORAGE" ->
190
        OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> arbitrary <*>
191
          genNameNE <*> arbitrary
192
      "OP_NODE_SET_PARAMS" ->
193
        OpCodes.OpNodeSetParams <$> genNodeNameNE <*> arbitrary <*>
194
          emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*> arbitrary <*>
195
          arbitrary <*> arbitrary <*> arbitrary <*> getMaybe genNameNE <*>
196
          emptyMUD
197
      "OP_NODE_POWERCYCLE" ->
198
        OpCodes.OpNodePowercycle <$> genNodeNameNE <*> arbitrary
199
      "OP_NODE_MIGRATE" ->
200
        OpCodes.OpNodeMigrate <$> genNodeNameNE <*> arbitrary <*>
201
          arbitrary <*> getMaybe genNodeNameNE <*> arbitrary <*>
202
          arbitrary <*> getMaybe genNameNE
203
      "OP_NODE_EVACUATE" ->
204
        OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*>
205
          getMaybe genNodeNameNE <*> getMaybe genNameNE <*> arbitrary
206
      "OP_INSTANCE_CREATE" ->
207
        OpCodes.OpInstanceCreate <$> getFQDN <*> arbitrary <*>
208
          arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*>
209
          arbitrary <*> arbitrary <*> arbitrary <*> getMaybe genNameNE <*>
210
          pure emptyJSObject <*> arbitrary <*> getMaybe genNameNE <*>
211
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
212
          arbitrary <*> arbitrary <*> pure emptyJSObject <*>
213
          getMaybe genNameNE <*>
214
          getMaybe genNodeNameNE <*> getMaybe genNodeNameNE <*>
215
          getMaybe (pure []) <*> getMaybe genNodeNameNE <*>
216
          arbitrary <*> getMaybe genNodeNameNE <*>
217
          getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
218
          arbitrary <*> (genTags >>= mapM mkNonEmpty)
219
      "OP_INSTANCE_MULTI_ALLOC" ->
220
        OpCodes.OpInstanceMultiAlloc <$> getMaybe genNameNE <*> pure []
221
      "OP_INSTANCE_REINSTALL" ->
222
        OpCodes.OpInstanceReinstall <$> getFQDN <*> arbitrary <*>
223
          getMaybe genNameNE <*> getMaybe (pure emptyJSObject)
224
      "OP_INSTANCE_REMOVE" ->
225
        OpCodes.OpInstanceRemove <$> getFQDN <*> arbitrary <*> arbitrary
226
      "OP_INSTANCE_RENAME" ->
227
        OpCodes.OpInstanceRename <$> getFQDN <*> genNodeNameNE <*>
228
          arbitrary <*> arbitrary
229
      "OP_INSTANCE_STARTUP" ->
230
        OpCodes.OpInstanceStartup <$> getFQDN <*> arbitrary <*> arbitrary <*>
231
          pure emptyJSObject <*> pure emptyJSObject <*>
232
          arbitrary <*> arbitrary
233
      "OP_INSTANCE_SHUTDOWN" ->
234
        OpCodes.OpInstanceShutdown <$> getFQDN <*> arbitrary <*>
235
          arbitrary <*> arbitrary
236
      "OP_INSTANCE_REBOOT" ->
237
        OpCodes.OpInstanceReboot <$> getFQDN <*> arbitrary <*>
238
          arbitrary <*> arbitrary
239
      "OP_INSTANCE_MOVE" ->
240
        OpCodes.OpInstanceMove <$> getFQDN <*> arbitrary <*> arbitrary <*>
241
          genNodeNameNE <*> arbitrary
242
      "OP_INSTANCE_CONSOLE" -> OpCodes.OpInstanceConsole <$> getFQDN
243
      "OP_INSTANCE_ACTIVATE_DISKS" ->
244
        OpCodes.OpInstanceActivateDisks <$> getFQDN <*>
245
          arbitrary <*> arbitrary
246
      "OP_INSTANCE_DEACTIVATE_DISKS" ->
247
        OpCodes.OpInstanceDeactivateDisks <$> getFQDN <*> arbitrary
248
      "OP_INSTANCE_RECREATE_DISKS" ->
249
        OpCodes.OpInstanceRecreateDisks <$> getFQDN <*> arbitrary <*>
250
          genNodeNamesNE <*> getMaybe genNameNE
251
      "OP_INSTANCE_QUERY" ->
252
        OpCodes.OpInstanceQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary
253
      "OP_INSTANCE_QUERY_DATA" ->
254
        OpCodes.OpInstanceQueryData <$> arbitrary <*>
255
          genNodeNamesNE <*> arbitrary
256
      "OP_INSTANCE_SET_PARAMS" ->
257
        OpCodes.OpInstanceSetParams <$> getFQDN <*> arbitrary <*>
258
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
259
          pure emptyJSObject <*> arbitrary <*> pure emptyJSObject <*>
260
          arbitrary <*> getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
261
          pure emptyJSObject <*> arbitrary <*> arbitrary <*> arbitrary
262
      "OP_INSTANCE_GROW_DISK" ->
263
        OpCodes.OpInstanceGrowDisk <$> getFQDN <*> arbitrary <*>
264
          arbitrary <*> arbitrary <*> arbitrary
265
      "OP_INSTANCE_CHANGE_GROUP" ->
266
        OpCodes.OpInstanceChangeGroup <$> getFQDN <*> arbitrary <*>
267
          getMaybe genNameNE <*> getMaybe (resize maxNodes (listOf genNameNE))
268
      "OP_GROUP_ADD" ->
269
        OpCodes.OpGroupAdd <$> genNameNE <*> arbitrary <*>
270
          emptyMUD <*> getMaybe genEmptyContainer <*>
271
          emptyMUD <*> emptyMUD <*> emptyMUD
272
      "OP_GROUP_ASSIGN_NODES" ->
273
        OpCodes.OpGroupAssignNodes <$> genNameNE <*> arbitrary <*>
274
          genNodeNamesNE
275
      "OP_GROUP_QUERY" ->
276
        OpCodes.OpGroupQuery <$> genFieldsNE <*> genNamesNE
277
      "OP_GROUP_SET_PARAMS" ->
278
        OpCodes.OpGroupSetParams <$> genNameNE <*> arbitrary <*>
279
          emptyMUD <*> getMaybe genEmptyContainer <*>
280
          emptyMUD <*> emptyMUD <*> emptyMUD
281
      "OP_GROUP_REMOVE" ->
282
        OpCodes.OpGroupRemove <$> genNameNE
283
      "OP_GROUP_RENAME" ->
284
        OpCodes.OpGroupRename <$> genNameNE <*> genNameNE
285
      "OP_GROUP_EVACUATE" ->
286
        OpCodes.OpGroupEvacuate <$> genNameNE <*> arbitrary <*>
287
          getMaybe genNameNE <*> getMaybe genNamesNE
288
      "OP_OS_DIAGNOSE" ->
289
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
290
      "OP_BACKUP_QUERY" ->
291
        OpCodes.OpBackupQuery <$> arbitrary <*> genNodeNamesNE
292
      "OP_BACKUP_PREPARE" ->
293
        OpCodes.OpBackupPrepare <$> getFQDN <*> arbitrary
294
      "OP_BACKUP_EXPORT" ->
295
        OpCodes.OpBackupExport <$> getFQDN <*> arbitrary <*>
296
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
297
          getMaybe (pure []) <*> getMaybe genNameNE
298
      "OP_BACKUP_REMOVE" ->
299
        OpCodes.OpBackupRemove <$> getFQDN
300
      "OP_TEST_ALLOCATOR" ->
301
        OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*>
302
          genNameNE <*> pure [] <*> pure [] <*>
303
          arbitrary <*> getMaybe genNameNE <*>
304
          (genTags >>= mapM mkNonEmpty) <*>
305
          arbitrary <*> arbitrary <*> getMaybe genNameNE <*>
306
          arbitrary <*> getMaybe genNodeNamesNE <*> arbitrary <*>
307
          getMaybe genNamesNE <*> arbitrary <*> arbitrary
308
      "OP_TEST_JQUEUE" ->
309
        OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*>
310
          resize 20 (listOf getFQDN) <*> arbitrary
311
      "OP_TEST_DUMMY" ->
312
        OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
313
          pure J.JSNull <*> pure J.JSNull
314
      "OP_NETWORK_ADD" ->
315
        OpCodes.OpNetworkAdd <$> genNameNE <*> arbitrary <*> genIp4Net <*>
316
          getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
317
          getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*>
318
          (genTags >>= mapM mkNonEmpty)
319
      "OP_NETWORK_REMOVE" ->
320
        OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary
321
      "OP_NETWORK_SET_PARAMS" ->
322
        OpCodes.OpNetworkSetParams <$> genNameNE <*> arbitrary <*>
323
          getMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
324
          getMaybe genMacPrefix <*> getMaybe (listOf genIp4Addr) <*>
325
          getMaybe (listOf genIp4Addr)
326
      "OP_NETWORK_CONNECT" ->
327
        OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*>
328
          arbitrary <*> genNameNE <*> arbitrary
329
      "OP_NETWORK_DISCONNECT" ->
330
        OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE <*> arbitrary
331
      "OP_NETWORK_QUERY" ->
332
        OpCodes.OpNetworkQuery <$> genFieldsNE <*> genNamesNE
333
      "OP_RESTRICTED_COMMAND" ->
334
        OpCodes.OpRestrictedCommand <$> arbitrary <*> genNodeNamesNE <*>
335
          genNameNE
336
      _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
337

    
338
-- * Helper functions
339

    
340
-- | Empty JSObject.
341
emptyJSObject :: J.JSObject J.JSValue
342
emptyJSObject = J.toJSObject []
343

    
344
-- | Empty maybe unchecked dictionary.
345
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
346
emptyMUD = getMaybe $ pure emptyJSObject
347

    
348
-- | Generates an empty container.
349
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
350
genEmptyContainer = pure . GenericContainer $ Map.fromList []
351

    
352
-- | Generates list of disk indices.
353
genDiskIndices :: Gen [DiskIndex]
354
genDiskIndices = do
355
  cnt <- choose (0, C.maxDisks)
356
  genUniquesList cnt
357

    
358
-- | Generates a list of node names.
359
genNodeNames :: Gen [String]
360
genNodeNames = resize maxNodes (listOf getFQDN)
361

    
362
-- | Generates a list of node names in non-empty string type.
363
genNodeNamesNE :: Gen [NonEmptyString]
364
genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
365

    
366
-- | Gets a node name in non-empty type.
367
genNodeNameNE :: Gen NonEmptyString
368
genNodeNameNE = getFQDN >>= mkNonEmpty
369

    
370
-- | Gets a name (non-fqdn) in non-empty type.
371
genNameNE :: Gen NonEmptyString
372
genNameNE = getName >>= mkNonEmpty
373

    
374
-- | Gets a list of names (non-fqdn) in non-empty type.
375
genNamesNE :: Gen [NonEmptyString]
376
genNamesNE = resize maxNodes (listOf genNameNE)
377

    
378
-- | Returns a list of non-empty fields.
379
genFieldsNE :: Gen [NonEmptyString]
380
genFieldsNE = getFields >>= mapM mkNonEmpty
381

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

    
391
-- | Generate an arbitrary IPv4 network address in textual form.
392
genIp4Net :: Gen NonEmptyString
393
genIp4Net = do
394
  netmask <- choose (8::Int, 30)
395
  ip <- genIp4Addr
396
  mkNonEmpty $ fromNonEmpty ip ++ "/" ++ show netmask
397

    
398
-- | Generate a 3-byte MAC prefix.
399
genMacPrefix :: Gen NonEmptyString
400
genMacPrefix = do
401
  octets <- vectorOf 3 $ choose (0::Int, 255)
402
  mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
403

    
404
-- * Test cases
405

    
406
-- | Check that opcode serialization is idempotent.
407
prop_serialization :: OpCodes.OpCode -> Property
408
prop_serialization = testSerialisation
409

    
410
-- | Check that Python and Haskell defined the same opcode list.
411
case_AllDefined :: HUnit.Assertion
412
case_AllDefined = do
413
  let py_ops = sort C.opcodesOpIds
414
      hs_ops = sort OpCodes.allOpIDs
415
      extra_py = py_ops \\ hs_ops
416
      extra_hs = hs_ops \\ py_ops
417
  HUnit.assertBool ("Missing OpCodes from the Haskell code:\n" ++
418
                    unlines extra_py) (null extra_py)
419
  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
420
                    unlines extra_hs) (null extra_hs)
421

    
422
-- | Custom HUnit test case that forks a Python process and checks
423
-- correspondence between Haskell-generated OpCodes and their Python
424
-- decoded, validated and re-encoded version.
425
--
426
-- Note that we have a strange beast here: since launching Python is
427
-- expensive, we don't do this via a usual QuickProperty, since that's
428
-- slow (I've tested it, and it's indeed quite slow). Rather, we use a
429
-- single HUnit assertion, and in it we manually use QuickCheck to
430
-- generate 500 opcodes times the number of defined opcodes, which
431
-- then we pass in bulk to Python. The drawbacks to this method are
432
-- two fold: we cannot control the number of generated opcodes, since
433
-- HUnit assertions don't get access to the test options, and for the
434
-- same reason we can't run a repeatable seed. We should probably find
435
-- a better way to do this, for example by having a
436
-- separately-launched Python process (if not running the tests would
437
-- be skipped).
438
case_py_compat :: HUnit.Assertion
439
case_py_compat = do
440
  let num_opcodes = length OpCodes.allOpIDs * 500
441
  sample_opcodes <- sample' (vectorOf num_opcodes
442
                             (arbitrary::Gen OpCodes.OpCode))
443
  let opcodes = head sample_opcodes
444
      serialized = J.encode opcodes
445
  py_stdout <-
446
     runPython "from ganeti import opcodes\n\
447
               \import sys\n\
448
               \from ganeti import serializer\n\
449
               \op_data = serializer.Load(sys.stdin.read())\n\
450
               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
451
               \for op in decoded:\n\
452
               \  op.Validate(True)\n\
453
               \encoded = [op.__getstate__() for op in decoded]\n\
454
               \print serializer.Dump(encoded)" serialized
455
     >>= checkPythonResult
456
  let deserialised = J.decode py_stdout::J.Result [OpCodes.OpCode]
457
  decoded <- case deserialised of
458
               J.Ok ops -> return ops
459
               J.Error msg ->
460
                 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)
461
                 -- this already raised an expection, but we need it
462
                 -- for proper types
463
                 >> fail "Unable to decode opcodes"
464
  HUnit.assertEqual "Mismatch in number of returned opcodes"
465
    (length opcodes) (length decoded)
466
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
467
        ) $ zip opcodes decoded
468

    
469
testSuite "OpCodes"
470
            [ 'prop_serialization
471
            , 'case_AllDefined
472
            , 'case_py_compat
473
            ]