Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / OpCodes.hs @ 8d239fa4

History | View | Annotate | Download (19.3 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 <$> arbitrary <*> arbitrary <*> arbitrary
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_DATA" ->
252
        OpCodes.OpInstanceQueryData <$> arbitrary <*>
253
          genNodeNamesNE <*> arbitrary
254
      "OP_INSTANCE_SET_PARAMS" ->
255
        OpCodes.OpInstanceSetParams <$> getFQDN <*> arbitrary <*>
256
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
257
          pure emptyJSObject <*> arbitrary <*> pure emptyJSObject <*>
258
          arbitrary <*> getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
259
          pure emptyJSObject <*> arbitrary <*> arbitrary <*> arbitrary
260
      "OP_INSTANCE_GROW_DISK" ->
261
        OpCodes.OpInstanceGrowDisk <$> getFQDN <*> arbitrary <*>
262
          arbitrary <*> arbitrary <*> arbitrary
263
      "OP_INSTANCE_CHANGE_GROUP" ->
264
        OpCodes.OpInstanceChangeGroup <$> getFQDN <*> arbitrary <*>
265
          getMaybe genNameNE <*> getMaybe (resize maxNodes (listOf genNameNE))
266
      "OP_GROUP_ADD" ->
267
        OpCodes.OpGroupAdd <$> genNameNE <*> arbitrary <*>
268
          emptyMUD <*> getMaybe genEmptyContainer <*>
269
          emptyMUD <*> emptyMUD <*> emptyMUD
270
      "OP_GROUP_ASSIGN_NODES" ->
271
        OpCodes.OpGroupAssignNodes <$> genNameNE <*> arbitrary <*>
272
          genNodeNamesNE
273
      "OP_GROUP_QUERY" ->
274
        OpCodes.OpGroupQuery <$> genFieldsNE <*> genNamesNE
275
      "OP_GROUP_SET_PARAMS" ->
276
        OpCodes.OpGroupSetParams <$> genNameNE <*> arbitrary <*>
277
          emptyMUD <*> getMaybe genEmptyContainer <*>
278
          emptyMUD <*> emptyMUD <*> emptyMUD
279
      "OP_GROUP_REMOVE" ->
280
        OpCodes.OpGroupRemove <$> genNameNE
281
      "OP_GROUP_RENAME" ->
282
        OpCodes.OpGroupRename <$> genNameNE <*> genNameNE
283
      "OP_GROUP_EVACUATE" ->
284
        OpCodes.OpGroupEvacuate <$> genNameNE <*> arbitrary <*>
285
          getMaybe genNameNE <*> getMaybe genNamesNE
286
      "OP_OS_DIAGNOSE" ->
287
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
288
      "OP_BACKUP_QUERY" ->
289
        OpCodes.OpBackupQuery <$> arbitrary <*> genNodeNamesNE
290
      "OP_BACKUP_PREPARE" ->
291
        OpCodes.OpBackupPrepare <$> getFQDN <*> arbitrary
292
      "OP_BACKUP_EXPORT" ->
293
        OpCodes.OpBackupExport <$> getFQDN <*> arbitrary <*>
294
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
295
          getMaybe (pure []) <*> getMaybe genNameNE
296
      "OP_BACKUP_REMOVE" ->
297
        OpCodes.OpBackupRemove <$> getFQDN
298
      "OP_TEST_ALLOCATOR" ->
299
        OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*>
300
          genNameNE <*> pure [] <*> pure [] <*>
301
          arbitrary <*> getMaybe genNameNE <*>
302
          (genTags >>= mapM mkNonEmpty) <*>
303
          arbitrary <*> arbitrary <*> getMaybe genNameNE <*>
304
          arbitrary <*> getMaybe genNodeNamesNE <*> arbitrary <*>
305
          getMaybe genNamesNE <*> arbitrary <*> arbitrary
306
      "OP_TEST_JQUEUE" ->
307
        OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*>
308
          resize 20 (listOf getFQDN) <*> arbitrary
309
      "OP_TEST_DUMMY" ->
310
        OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
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
331
      _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
332

    
333
-- * Helper functions
334

    
335
-- | Empty JSObject.
336
emptyJSObject :: J.JSObject J.JSValue
337
emptyJSObject = J.toJSObject []
338

    
339
-- | Empty maybe unchecked dictionary.
340
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
341
emptyMUD = getMaybe $ pure emptyJSObject
342

    
343
-- | Generates an empty container.
344
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
345
genEmptyContainer = pure . GenericContainer $ Map.fromList []
346

    
347
-- | Generates list of disk indices.
348
genDiskIndices :: Gen [DiskIndex]
349
genDiskIndices = do
350
  cnt <- choose (0, C.maxDisks)
351
  genUniquesList cnt
352

    
353
-- | Generates a list of node names.
354
genNodeNames :: Gen [String]
355
genNodeNames = resize maxNodes (listOf getFQDN)
356

    
357
-- | Generates a list of node names in non-empty string type.
358
genNodeNamesNE :: Gen [NonEmptyString]
359
genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
360

    
361
-- | Gets a node name in non-empty type.
362
genNodeNameNE :: Gen NonEmptyString
363
genNodeNameNE = getFQDN >>= mkNonEmpty
364

    
365
-- | Gets a name (non-fqdn) in non-empty type.
366
genNameNE :: Gen NonEmptyString
367
genNameNE = getName >>= mkNonEmpty
368

    
369
-- | Gets a list of names (non-fqdn) in non-empty type.
370
genNamesNE :: Gen [NonEmptyString]
371
genNamesNE = resize maxNodes (listOf genNameNE)
372

    
373
-- | Returns a list of non-empty fields.
374
genFieldsNE :: Gen [NonEmptyString]
375
genFieldsNE = getFields >>= mapM mkNonEmpty
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

    
399
-- * Test cases
400

    
401
-- | Check that opcode serialization is idempotent.
402
prop_serialization :: OpCodes.OpCode -> Property
403
prop_serialization = testSerialisation
404

    
405
-- | Check that Python and Haskell defined the same opcode list.
406
case_AllDefined :: HUnit.Assertion
407
case_AllDefined = do
408
  py_stdout <- runPython "from ganeti import opcodes\n\
409
                         \print '\\n'.join(opcodes.OP_MAPPING.keys())" "" >>=
410
               checkPythonResult
411
  let py_ops = sort $ lines py_stdout
412
      hs_ops = OpCodes.allOpIDs
413
      -- extra_py = py_ops \\ hs_ops
414
      extra_hs = hs_ops \\ py_ops
415
  -- FIXME: uncomment when we have parity
416
  -- HUnit.assertBool ("OpCodes missing from Haskell code:\n" ++
417
  --                  unlines extra_py) (null extra_py)
418
  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
419
                    unlines extra_hs) (null extra_hs)
420

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

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