Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / OpCodes.hs @ 3131adc7

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 <$> genFQDN
60
                    , OpCodes.TagNode     <$> genFQDN
61
                    , OpCodes.TagGroup    <$> genFQDN
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 <$> genMaybe genNameNE <*> genMaybe genName <*>
74
              genMaybe genNameNE <*> genMaybe genNameNE
75

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

    
337
-- * Helper functions
338

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

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

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

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

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

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

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

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

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

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

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

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

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

    
403
-- * Test cases
404

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

    
409
-- | Check that Python and Haskell defined the same opcode list.
410
case_AllDefined :: HUnit.Assertion
411
case_AllDefined = do
412
  let py_ops = sort C.opcodesOpIds
413
      hs_ops = sort OpCodes.allOpIDs
414
      extra_py = py_ops \\ hs_ops
415
      extra_hs = hs_ops \\ py_ops
416
  HUnit.assertBool ("Missing OpCodes from the 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
            ]